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

Data update

Browse source
This commit is contained in:
Ingy döt Net 2025-02-27 18:35:13 -05:00
parent 8e4e15fa56
commit 72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
Download patch file Download diff file Expand all files Collapse all files

19
Task/Gamma-function/EMal/gamma-function.emal Normal file
View file

@ -0,0 +1,19 @@
fun stirling ← <real x|√(2 * PI / x) * ((x / E) ** x)
fun lanczos ← real by real x
List p ← real[0.99999999999980993, 676.5203681218851, -1259.1392167224028,
771.32342877765313, -176.61502916214059, 12.507343278686905,
-0.13857109526572012, 0.0000099843695780195716, 0.00000015056327351493116]
int g ← 7
if x < 0.5 do return PI / (sin(PI * x) * lanczos(1 - x)) end
x -← 1
real a ← p[0]
real t ← x + g + 0.5
for int i ← 1; i < p.length; ++i
a +← p[i] / (x + i)
end
return √(2 * PI) * (t ** (x + 0.5)) * (E ** (-t)) * a
end
writeLine("x", "\t", "Stirling", "\t\t\t", "Lanczos")
for real x ← 0.1; x ≤ 2 ; x +← 0.1
writeLine(x, "\t", stirling(x), "\t", lanczos(x))
end

68
Task/Gamma-function/REXX/gamma-function-1.rexx
View file

@ -1,68 +0,0 @@
/*REXX program calculates GAMMA using the Taylor series coefficients; ≈80 decimal digits*/
/*The GAMMA function symbol is the Greek capital letter: Γ */
numeric digits 90 /*be able to handle extended precision.*/
parse arg LO HI . /*allow specification of gamma arg/args*/
/* [↓] either show a range or a ··· */
do j=word(LO 1, 1) to word(HI LO 9, 1) /* ··· single gamma value.*/
say 'gamma('j") =" gamma(j) /*compute gamma of J and display value.*/
end /*j*/ /* [↑] default LO is one; HI is nine.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
gamma: procedure; parse arg x; xm=x-1; sum=0
/*coefficients thanks to: Arne Fransén & Staffan Wrigge.*/
#.1 = 1 /* [↓] #.2 is the Euler-Mascheroni constant. */
#.2 = 0.57721566490153286060651209008240243104215933593992359880576723488486772677766467
#.3 = -0.65587807152025388107701951514539048127976638047858434729236244568387083835372210
#.4 = -0.04200263503409523552900393487542981871139450040110609352206581297618009687597599
#.5 = 0.16653861138229148950170079510210523571778150224717434057046890317899386605647425
#.6 = -0.04219773455554433674820830128918739130165268418982248637691887327545901118558900
#.7 = -0.00962197152787697356211492167234819897536294225211300210513886262731167351446074
#.8 = 0.00721894324666309954239501034044657270990480088023831800109478117362259497415854
#.9 = -0.00116516759185906511211397108401838866680933379538405744340750527562002584816653
#.10 = -0.00021524167411495097281572996305364780647824192337833875035026748908563946371678
#.11 = 0.00012805028238811618615319862632816432339489209969367721490054583804120355204347
#.12 = -0.00002013485478078823865568939142102181838229483329797911526116267090822918618897
#.13 = -0.00000125049348214267065734535947383309224232265562115395981534992315749121245561
#.14 = 0.00000113302723198169588237412962033074494332400483862107565429550539546040842730
#.15 = -0.00000020563384169776071034501541300205728365125790262933794534683172533245680371
#.16 = 0.00000000611609510448141581786249868285534286727586571971232086732402927723507435
#.17 = 0.00000000500200764446922293005566504805999130304461274249448171895337887737472132
#.18 = -0.00000000118127457048702014458812656543650557773875950493258759096189263169643391
#.19 = 0.00000000010434267116911005104915403323122501914007098231258121210871073927347588
#.20 = 0.00000000000778226343990507125404993731136077722606808618139293881943550732692987
#.21 = -0.00000000000369680561864220570818781587808576623657096345136099513648454655443000
#.22 = 0.00000000000051003702874544759790154813228632318027268860697076321173501048565735
#.23 = -0.00000000000002058326053566506783222429544855237419746091080810147188058196444349
#.24 = -0.00000000000000534812253942301798237001731872793994898971547812068211168095493211
#.25 = 0.00000000000000122677862823826079015889384662242242816545575045632136601135999606
#.26 = -0.00000000000000011812593016974587695137645868422978312115572918048478798375081233
#.27 = 0.00000000000000000118669225475160033257977724292867407108849407966482711074006109
#.28 = 0.00000000000000000141238065531803178155580394756670903708635075033452562564122263
#.29 = -0.00000000000000000022987456844353702065924785806336992602845059314190367014889830
#.30 = 0.00000000000000000001714406321927337433383963370267257066812656062517433174649858
#.31 = 0.00000000000000000000013373517304936931148647813951222680228750594717618947898583
#.32 = -0.00000000000000000000020542335517666727893250253513557337960820379352387364127301
#.33 = 0.00000000000000000000002736030048607999844831509904330982014865311695836363370165
#.34 = -0.00000000000000000000000173235644591051663905742845156477979906974910879499841377
#.35 = -0.00000000000000000000000002360619024499287287343450735427531007926413552145370486
#.36 = 0.00000000000000000000000001864982941717294430718413161878666898945868429073668232
#.37 = -0.00000000000000000000000000221809562420719720439971691362686037973177950067567580
#.38 = 0.00000000000000000000000000012977819749479936688244144863305941656194998646391332
#.39 = 0.00000000000000000000000000000118069747496652840622274541550997151855968463784158
#.40 = -0.00000000000000000000000000000112458434927708809029365467426143951211941179558301
#.41 = 0.00000000000000000000000000000012770851751408662039902066777511246477487720656005
#.42 = -0.00000000000000000000000000000000739145116961514082346128933010855282371056899245
#.43 = 0.00000000000000000000000000000000001134750257554215760954165259469306393008612196
#.44 = 0.00000000000000000000000000000000004639134641058722029944804907952228463057968680
#.45 = -0.00000000000000000000000000000000000534733681843919887507741819670989332090488591
#.46 = 0.00000000000000000000000000000000000032079959236133526228612372790827943910901464
#.47 = -0.00000000000000000000000000000000000000444582973655075688210159035212464363740144
#.48 = -0.00000000000000000000000000000000000000131117451888198871290105849438992219023663
#.49 = 0.00000000000000000000000000000000000000016470333525438138868182593279063941453996
#.50 = -0.00000000000000000000000000000000000000001056233178503581218600561071538285049997
#.51 = 0.00000000000000000000000000000000000000000026784429826430494783549630718908519485
#.52 = 0.00000000000000000000000000000000000000000002424715494851782689673032938370921241
#=52; do k=# by -1 for #
sum=sum*xm + #.k
end /*k*/
return 1/sum

69
Task/Gamma-function/REXX/gamma-function-2.rexx
View file

@ -1,69 +0,0 @@
/*REXX program calculates the gamma function using Spouge's approximation with 87 digits*/
e=2.71828182845904523536028747135266249775724709369995957496696762772407663035354759457138
numeric digits length(e) - length(.) /*use the number of decimal digits in E*/
c.= 0
# = 40 /*#: the number of steps in GAMMA func*/
call sq gamma(-3/2), 3/4
call sq gamma(-1/2), -1/2
call sq gamma( 1/2), 1
call si gamma( 1 )
call sq gamma( 3/2), 2
call si gamma( 2 )
call sq gamma( 5/2), 4/3
call si gamma( 3 )
call sq gamma( 7/2), 8/15
call si gamma( 4 )
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
gamma: procedure expose c. e #; parse arg z; #p= # + 1
accm = c.1
if accm==0 then do; accm= sqrt( 2*pi() )
c.1 = accm
kfact = 1
do k=2 to #
c.k= exp(#p-k) * pow(#p-k, k-1.5) / kfact
kfact = kfact * -(k-1)
end /*k*/
end
do j=2 to #; accm = accm + c.j / (z+j-1)
end /*k*/
return (accm * exp(-(z+#)) * pow(z+#, z+0.5) ) / z
/*──────────────────────────────────────────────────────────────────────────────────────*/
pi: return 3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348
fmt: parse arg n,p,a; _= format(n,p,a); L= length(_); return left( strip0(_), L)
isInt: return datatype(arg(1), 'W') /*is the argument an integer? */
sq: procedure expose #; parse arg x,mu; say fmt(x,9,#) fmt((x*mu)**2,9,#); return
si: procedure expose #; parse arg x; say fmt(x,9,#); return
strip0: procedure; arg _; if pos(., _)\==0 then _= strip(strip(_,'T',0),'T',.); return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
exp: procedure expose e; arg x; ix= x%1; if abs(x-ix)>.5 then ix=ix+sign(x); x= x-ix; z=1
_=1; w=1; do j=1; _= _*x/j; z= (z+_)/1; if z==w then leave; w=z
end /*j*/; if z\==0 then z= e**ix * z; return z
/*──────────────────────────────────────────────────────────────────────────────────────*/
ln: procedure; parse arg x; call e; ig= x>1.5; is= 1-2*(ig\==1); ii= 0; xx= x
do while ig & xx>1.5 | \ig & xx<.5; _=e
do k=-1; iz=xx*_**-is; if k>=0&(ig&iz<1|\ig&iz>.5) then leave; _=_*_; izz=iz; end
xx= izz; ii= ii+is*2**k; end /*while*/; x= x*e**-ii-1; z=0; _= -1; p=z
do k=1; _=-_*x; z=z+_/k; if z=p then leave; p=z; end; /*k*/; return z+ii
/*──────────────────────────────────────────────────────────────────────────────────────*/
pow: procedure; parse arg x,y; if y=0 then return 1; if x=0 then return 0
if isInt(y) then return x**y; if isInt(1/y) then return root(x, 1/y)
if abs(y//1)=.5 then return sqrt(x)**sign(y)*x**(y%1); return exp( y*ln(x) )
/*──────────────────────────────────────────────────────────────────────────────────────*/
root: procedure; parse arg x 1 ox,y 1 oy; if x=0 | y=1 then return x/1
if \isInt(y) then return $pow(x, 1/y)
if y==2 then return sqrt(x); if y==-2 then return 1/sqrt(x); return rooti(x,y)/1
/*──────────────────────────────────────────────────────────────────────────────────────*/
rooti: x=abs(x); y=abs(y); a= digits() + 5; m= y-1; d= 5
parse value format(x,2,1,,0) 'E0' with ? 'E' _ .; g= (?/y'E'_ % y) + (x>1)
do until d==a; d=min(d+d, a); numeric digits d; o=0
do until o=g; o=g; g= format((m*g**y+x)/y/g**m,,d-2); end; end
_= g*sign(ox); if oy<0 then _= 1/_; return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); numeric digits; h=d+6
numeric form; m.=9; 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

175
Task/Gamma-function/REXX/gamma-function-3.rexx
View file

@ -1,175 +0,0 @@
include Settings
say version; say 'Gamma'; say
arg n; if n = '' then n = 100; numeric digits n
say '(Half)integers formulas'
w = '-99.5 -10.5 -5.5 -2.5 -1.5 -0.5 0.5 1 1.5 2 2.5 5 5.5 10 10.5 99 99.5'
numeric digits n
do i = 1 to Words(w)
x = Word(w,i); call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Formulas' Format(x,4,1) r '('e 'seconds)'
end
say
say 'Lanczos (max 60 decimals) vs Spouge (no limit) vs Stirling (no limit) approximation'
w = '-12.8 -6.4 -3.2 -1.6 -0.8 -0.4 -0.2 -0.1 0.1 0.2 0.4 0.8 1.6 3.2 6.4 12.8'
do i = 1 to Words(w)
x = Word(w,i)
numeric digits Min(60,n)
call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Lanczos ' Format(x,4,1) r '('e 'seconds)'
numeric digits n
call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Spouge ' Format(x,4,1) r '('e 'seconds)'
if x > 0 then do
call Time('r'); r = Stirling(x); e = Format(Time('e'),,3)
say 'Stirling' Format(x,4,1) r '('e 'seconds)'
end
end
say
say 'Same for a bigger number'
w = '-99.9 99.9'
do i = 1 to Words(w)
x = Word(w,i)
numeric digits Min(60,n)
call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Lanczos ' Format(x,4,1) r '('e 'seconds)'
numeric digits n
call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Spouge ' Format(x,4,1) r '('e 'seconds)'
if x > 0 then do
call Time('r'); r = Stirling(x); e = Format(Time('e'),,3)
say 'Stirling' Format(x,4,1) r '('e 'seconds)'
end
end
exit
Gamma:
/* Gamma */
procedure expose glob. fact.
arg x
/* Formulas for negative and positive (half)integers */
if x < 0 then do
if Half(x) then do
numeric digits Digits()+2
i = Abs(Floor(x)); y = (-1)**i*2**(2*i)*Fact(i)*Sqrt(Pi())/Fact(2*i)
numeric digits Digits()-2
return y+0
end
end
if x > 0 then do
if Whole(x) then
return Fact(x-1)
if Half(x) then do
numeric digits Digits()+2
i = Floor(x); y = Fact(2*i)*Sqrt(Pi())/(2**(2*i)*Fact(i))
numeric digits Digits()-2
return y+0
end
end
p = Digits()
if p < 61 then do
/* Lanczos with predefined coefficients */
/* Map negative x to positive x */
if x < 0 then
return Pi()/(Gamma(1-x)*Sin(Pi()*x))
/* Argument reduction to interval (0.5,1.5) */
numeric digits p+2
c = Trunc(x); x = x-c
if x < 0.5 then do
x = x+1; c = c-1
end
/* Series coefficients 1/Gamma(x) in 80 digits Fransen & Wrigge */
c.1 = 1.00000000000000000000000000000000000000000000000000000000000000000000000000000000
c.2 = 0.57721566490153286060651209008240243104215933593992359880576723488486772677766467
c.3 = -0.65587807152025388107701951514539048127976638047858434729236244568387083835372210
c.4 = -0.04200263503409523552900393487542981871139450040110609352206581297618009687597599
c.5 = 0.16653861138229148950170079510210523571778150224717434057046890317899386605647425
c.6 = -0.04219773455554433674820830128918739130165268418982248637691887327545901118558900
c.7 = -0.00962197152787697356211492167234819897536294225211300210513886262731167351446074
c.8 = 0.00721894324666309954239501034044657270990480088023831800109478117362259497415854
c.9 = -0.00116516759185906511211397108401838866680933379538405744340750527562002584816653
c.10 = -0.00021524167411495097281572996305364780647824192337833875035026748908563946371678
c.11 = 0.00012805028238811618615319862632816432339489209969367721490054583804120355204347
c.12 = -0.00002013485478078823865568939142102181838229483329797911526116267090822918618897
c.13 = -0.00000125049348214267065734535947383309224232265562115395981534992315749121245561
c.14 = 0.00000113302723198169588237412962033074494332400483862107565429550539546040842730
c.15 = -0.00000020563384169776071034501541300205728365125790262933794534683172533245680371
c.16 = 0.00000000611609510448141581786249868285534286727586571971232086732402927723507435
c.17 = 0.00000000500200764446922293005566504805999130304461274249448171895337887737472132
c.18 = -0.00000000118127457048702014458812656543650557773875950493258759096189263169643391
c.19 = 0.00000000010434267116911005104915403323122501914007098231258121210871073927347588
c.20 = 0.00000000000778226343990507125404993731136077722606808618139293881943550732692987
c.21 = -0.00000000000369680561864220570818781587808576623657096345136099513648454655443000
c.22 = 0.00000000000051003702874544759790154813228632318027268860697076321173501048565735
c.23 = -0.00000000000002058326053566506783222429544855237419746091080810147188058196444349
c.24 = -0.00000000000000534812253942301798237001731872793994898971547812068211168095493211
c.25 = 0.00000000000000122677862823826079015889384662242242816545575045632136601135999606
c.26 = -0.00000000000000011812593016974587695137645868422978312115572918048478798375081233
c.27 = 0.00000000000000000118669225475160033257977724292867407108849407966482711074006109
c.28 = 0.00000000000000000141238065531803178155580394756670903708635075033452562564122263
c.29 = -0.00000000000000000022987456844353702065924785806336992602845059314190367014889830
c.30 = 0.00000000000000000001714406321927337433383963370267257066812656062517433174649858
c.31 = 0.00000000000000000000013373517304936931148647813951222680228750594717618947898583
c.32 = -0.00000000000000000000020542335517666727893250253513557337960820379352387364127301
c.33 = 0.00000000000000000000002736030048607999844831509904330982014865311695836363370165
c.34 = -0.00000000000000000000000173235644591051663905742845156477979906974910879499841377
c.35 = -0.00000000000000000000000002360619024499287287343450735427531007926413552145370486
c.36 = 0.00000000000000000000000001864982941717294430718413161878666898945868429073668232
c.37 = -0.00000000000000000000000000221809562420719720439971691362686037973177950067567580
c.38 = 0.00000000000000000000000000012977819749479936688244144863305941656194998646391332
c.39 = 0.00000000000000000000000000000118069747496652840622274541550997151855968463784158
c.40 = -0.00000000000000000000000000000112458434927708809029365467426143951211941179558301
c.41 = 0.00000000000000000000000000000012770851751408662039902066777511246477487720656005
c.42 = -0.00000000000000000000000000000000739145116961514082346128933010855282371056899245
c.43 = 0.00000000000000000000000000000000001134750257554215760954165259469306393008612196
c.44 = 0.00000000000000000000000000000000004639134641058722029944804907952228463057968680
c.45 = -0.00000000000000000000000000000000000534733681843919887507741819670989332090488591
c.46 = 0.00000000000000000000000000000000000032079959236133526228612372790827943910901464
c.47 = -0.00000000000000000000000000000000000000444582973655075688210159035212464363740144
c.48 = -0.00000000000000000000000000000000000000131117451888198871290105849438992219023663
c.49 = 0.00000000000000000000000000000000000000016470333525438138868182593279063941453996
c.50 = -0.00000000000000000000000000000000000000001056233178503581218600561071538285049997
c.51 = 0.00000000000000000000000000000000000000000026784429826430494783549630718908519485
c.52 = 0.00000000000000000000000000000000000000000002424715494851782689673032938370921241
/* Series expansion */
x = x-1; s = 0
do k = 52 by -1 to 1
s = s*x+c.k
end
y = 1/s
/* Undo reduction */
if c = -1 then
y = y/x
else do
do i = 1 to c
y = (x+i)*y
end
end
end
else do
x = x-1
/* Spouge */
/* Estimate digits and iterations */
q = Floor(p*1.5); a = Floor(p*1.3)
numeric digits q
/* Series */
s = 0
do k = 1 to a-1
s = s+((-1)**(k-1)*Power(a-k,k-0.5)*Exp(a-k))/(Fact(k-1)*(x+k))
end
s = s+Sqrt(2*Pi()); y = Power(x+a,x+0.5)*Exp(-a-x)*s
end
/* Normalize */
numeric digits p
return y+0
Stirling:
/* Sterling */
procedure expose glob. fact.
arg x
return Sqrt(2*Pi()/x) * Power(x/e(),x)
include Constants
include Functions
include Numbers
include Abend

55
Task/Gamma-function/REXX/gamma-function.rexx Normal file
View file

@ -0,0 +1,55 @@
include Settings
say version; say 'Gamma'; say
arg n; if n = '' then n = 100; numeric digits n
say '(Half)integers formulas'
w = '-99.5 -10.5 -5.5 -2.5 -1.5 -0.5 0.5 1 1.5 2 2.5 5 5.5 10 10.5 99 99.5'
numeric digits n
do i = 1 to Words(w)
x = Word(w,i); call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Formulas' Format(x,4,1) r '('e 'seconds)'
end
say
say 'Lanczos (max 60 decimals) vs Spouge (no limit) vs Stirling (no limit) approximation'
w = '-12.8 -6.4 -3.2 -1.6 -0.8 -0.4 -0.2 -0.1 0.1 0.2 0.4 0.8 1.6 3.2 6.4 12.8'
do i = 1 to Words(w)
x = Word(w,i)
numeric digits Min(60,n)
call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Lanczos ' Format(x,4,1) r '('e 'seconds)'
numeric digits n
call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Spouge ' Format(x,4,1) r '('e 'seconds)'
if x > 0 then do
call Time('r'); r = Stirling(x); e = Format(Time('e'),,3)
say 'Stirling' Format(x,4,1) r '('e 'seconds)'
end
end
say
say 'Same for a bigger number'
w = '-99.9 99.9'
do i = 1 to Words(w)
x = Word(w,i)
numeric digits Min(60,n)
call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Lanczos ' Format(x,4,1) r '('e 'seconds)'
numeric digits n
call Time('r'); r = Gamma(x); e = Format(Time('e'),,3)
say 'Spouge ' Format(x,4,1) r '('e 'seconds)'
if x > 0 then do
call Time('r'); r = Stirling(x); e = Format(Time('e'),,3)
say 'Stirling' Format(x,4,1) r '('e 'seconds)'
end
end
exit
Stirling:
/* Sterling */
procedure expose glob. fact.
arg x
return Sqrt(2*Pi()/x) * Power(x/e(),x)
include Constants
include Functions
include Numbers
include Abend