Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
|
|
@ -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,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,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,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,29 @@
|
|||
function agm{T<:FloatingPoint,U<:Integer}(x::T, y::T, e::U=5)
|
||||
0 < y && 0 < y && 0 < e || throw(DomainError())
|
||||
err = e*eps(x)
|
||||
(g, a) = extrema([x, y])
|
||||
while err < (a - g)
|
||||
ap = a
|
||||
a = 0.5*(a + g)
|
||||
g = sqrt(ap*g)
|
||||
end
|
||||
return a
|
||||
end
|
||||
|
||||
x = 1.0
|
||||
y = 1.0/sqrt(2.0)
|
||||
|
||||
println("Using literal-precision float numbers:")
|
||||
println(" agm(", x, ",", y, ") = ", agm(x, y))
|
||||
|
||||
println()
|
||||
println("Using half-precision float numbers:")
|
||||
x = float16(x)
|
||||
y = float16(y)
|
||||
println(" agm(", x, ",", y, ") = ", agm(x, y))
|
||||
|
||||
println()
|
||||
println("Using ", get_bigfloat_precision(), "-bit float numbers:")
|
||||
x = BigFloat(1.0)
|
||||
y = x/sqrt(BigFloat(2.0))
|
||||
println(" agm(", x, ",", y, ") = \n ", agm(x, y))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
function agm ([Double]$a, [Double]$g) {
|
||||
[Double]$eps = 1E-15
|
||||
[Double]$a1 = [Double]$g1 = 0
|
||||
while([Math]::Abs($a - $g) -gt $eps) {
|
||||
$a1, $g1 = $a, $g
|
||||
$a = ($a1 + $g1)/2
|
||||
$g = [Math]::Sqrt($a1*$g1)
|
||||
}
|
||||
[pscustomobject]@{
|
||||
a = "$a"
|
||||
g = "$g"
|
||||
}
|
||||
}
|
||||
agm 1 (1/[Math]::Sqrt(2))
|
||||
|
|
@ -1,29 +1,30 @@
|
|||
/*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
|
||||
/*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. */
|
||||
ox=x+1
|
||||
do while ox\=x & abs(ox)>tiny; ox=x; oy=y
|
||||
x=(ox+oy)/2; y=sqrt(ox*oy)
|
||||
end /*while ··· */
|
||||
|
||||
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
|
||||
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.*/
|
||||
|
|
|
|||
|
|
@ -1,16 +1,11 @@
|
|||
// http://rosettacode.org/wiki/Arithmetric-geometric_mean
|
||||
// Accepts two command line arguments
|
||||
// cargo run --name agm arg1 arg2
|
||||
|
||||
use std::num;
|
||||
|
||||
#[cfg(not(test))]
|
||||
fn main () {
|
||||
let args = std::os::args();
|
||||
let args = args.as_slice();
|
||||
let mut args = std::env::args();
|
||||
|
||||
let x = from_str::<f32>(args[1].as_slice()).unwrap() ;
|
||||
let y = from_str::<f32>(args[2].as_slice()).unwrap() ;
|
||||
let x = args.nth(1).expect("First argument not specified.").parse::<f32>().unwrap();
|
||||
let y = args.next().expect("Second argument not specified.").parse::<f32>().unwrap();
|
||||
|
||||
let result = agm(x,y);
|
||||
println!("The arithmetic-geometric mean is {}", result);
|
||||
|
|
@ -26,12 +21,11 @@ fn agm (x: f32, y: f32) -> f32 {
|
|||
if a * g < 0f32 { panic!("The arithmetric-geometric mean is undefined for numbers less than zero!"); }
|
||||
else {
|
||||
loop {
|
||||
a1 = (a + g) / 2f32;
|
||||
a1 = (a + g) / 2.;
|
||||
g1 = (a * g).sqrt();
|
||||
a = a1;
|
||||
g = g1;
|
||||
if num::abs( a - g) < e { return a; }
|
||||
if (a - g).abs() < e { return a; }
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
1→A:1/sqrt(2)→G
|
||||
While abs(A-G)>e-15
|
||||
(A+G)/2→B
|
||||
sqrt(AG)→G:B→A
|
||||
End
|
||||
A
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
Function agm(a,g)
|
||||
Do Until a = tmp_a
|
||||
tmp_a = a
|
||||
a = (a + g)/2
|
||||
g = Sqr(tmp_a * g)
|
||||
Loop
|
||||
agm = a
|
||||
End Function
|
||||
|
||||
WScript.Echo agm(1,1/Sqr(2))
|
||||
Loading…
Add table
Add a link
Reference in a new issue