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

September Morn Update

Browse source
This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
Download patch file Download diff file Expand all files Collapse all files

42
Task/Gamma-function/Crystal/gamma-function.crystal Normal file
View file

@ -0,0 +1,42 @@
# Taylor Series
def a
[ 1.00000_00000_00000_00000, 0.57721_56649_01532_86061, -0.65587_80715_20253_88108,
-0.04200_26350_34095_23553, 0.16653_86113_82291_48950, -0.04219_77345_55544_33675,
-0.00962_19715_27876_97356, 0.00721_89432_46663_09954, -0.00116_51675_91859_06511,
-0.00021_52416_74114_95097, 0.00012_80502_82388_11619, -0.00002_01348_54780_78824,
-0.00000_12504_93482_14267, 0.00000_11330_27231_98170, -0.00000_02056_33841_69776,
0.00000_00061_16095_10448, 0.00000_00050_02007_64447, -0.00000_00011_81274_57049,
0.00000_00001_04342_67117, 0.00000_00000_07782_26344, -0.00000_00000_03696_80562,
0.00000_00000_00510_03703, -0.00000_00000_00020_58326, -0.00000_00000_00005_34812,
0.00000_00000_00001_22678, -0.00000_00000_00000_11813, 0.00000_00000_00000_00119,
0.00000_00000_00000_00141, -0.00000_00000_00000_00023, 0.00000_00000_00000_00002 ]
end
def taylor_gamma(x)
y = x.to_f - 1
1.0 / a.reverse.reduce(0) { |sum, an| sum * y + an }
end
# Lanczos Method
def p
[ 0.99999_99999_99809_93, 676.52036_81218_851, -1259.13921_67224_028,
771.32342_87776_5313, -176.61502_91621_4059, 12.50734_32786_86905,
-0.13857_10952_65720_12, 9.98436_95780_19571_6e-6, 1.50563_27351_49311_6e-7 ]
end
def lanczos_gamma(z)
# Reflection formula
z = z.to_f
if z < 0.5
Math::PI / (Math.sin(Math::PI * z) * lanczos_gamma(1 - z))
else
z -= 1
x = p[0]
(1..p.size - 1).each { |i| x += p[i] / (z + i) }
t = z + p.size - 1.5
Math.sqrt(2 * Math::PI) * t**(z + 0.5) * Math.exp(-t) * x
end
end
puts " Taylor Series Lanczos Method Builtin Function"
(1..27).each { |i| n = i/3.0; puts "gamma(%.2f) = %.14e %.14e %.14e" % [n, taylor_gamma(n), lanczos_gamma(n), Math.gamma(n)] }

5
Task/Gamma-function/Factor/gamma-function.factor Normal file
View file

@ -0,0 +1,5 @@
! built in
USING: picomath prettyprint ;
0.1 gamma . ! 9.513507698668723
2.0 gamma . ! 1.0
10. gamma . ! 362880.0

27
Task/Gamma-function/Haskell/gamma-function-2.hs
View file

@ -1,7 +1,22 @@
procedure main()
every write(left(i := !10/10.0,5),gamma(.i))
end
import Control.Applicative
procedure gamma(z) # Stirling's approximation
return (2*&pi/z)^0.5 * (z/&e)^z
end
cof :: [Double]
cof =
[ 76.18009172947146
, -86.50532032941677
, 24.01409824083091
, -1.231739572450155
, 0.001208650973866179
, -0.000005395239384953
]
gammaln :: Double -> Double
gammaln =
((+) . negate . (((-) . (5.5 +)) <*> (((*) . (0.5 +)) <*> (log . (5.5 +))))) <*>
(log .
((/) =<<
(2.5066282746310007 *) .
(1.000000000190015 +) . sum . zipWith (/) cof . enumFrom . (1 +)))
main :: IO ()
main = mapM_ print $ gammaln <$> [0.1,0.2 .. 1.0]

7
Task/Gamma-function/Haskell/gamma-function-3.hs Normal file
View file

@ -0,0 +1,7 @@
procedure main()
every write(left(i := !10/10.0,5),gamma(.i))
end
procedure gamma(z) # Stirling's approximation
return (2*&pi/z)^0.5 * (z/&e)^z
end

16
Task/Gamma-function/Julia/gamma-function-3.julia
View file

@ -1,14 +1,2 @@
julia> x = rand(10)*20
julia> (gamma_quad(x) - gamma(x)) ./ gamma(x)
10-element Array{Any,1}:
-1.64473e-16
1.30036e-16
0.0
-1.92627e-16
0.0
2.06808e-16
-1.46141e-16
1.65947e-16
0.0
0.0
using SpecialFunctions
gamma(1/2) - sqrt(pi)

2
Task/Gamma-function/Nim/gamma-function.nim
View file

@ -10,7 +10,7 @@ const a = [
0.00000000000000122678, -0.00000000000000011813, 0.00000000000000000119,
0.00000000000000000141, -0.00000000000000000023, 0.00000000000000000002 ]
proc gamma(x): float =
proc gamma(x: float): float =
let y = x.float - 1.0
result = a[a.high]
for n in countdown(high(a) - 1, low(a)):

0
Task/Gamma-function/Phix/gamma-function.phix → Task/Gamma-function/Phix/gamma-function-1.phix
View file

95
Task/Gamma-function/Phix/gamma-function-2.phix Normal file
View file

@ -0,0 +1,95 @@
include mpfr.e
mpfr_set_default_prec(-87) -- 87 decimal places.
sequence c = mpfr_inits(40)
function gamma(atom z)
mpfr accm = c[1]
if mpfr_cmp_si(accm,0)=0 then
-- c[1] := sqrt(2*PI)
mpfr_const_pi(accm)
mpfr_mul_si(accm,accm,2)
mpfr_sqrt(accm,accm)
-- k1_factrl = (k - 1)!*(-1)^k with 0!==1
mpfr k1_factrl = mpfr_init(1),
tmk = mpfr_init(),
p = mpfr_init()
for k=2 to length(c) do
-- c[k] = exp(13-k)*power(13-k,k-1.5)/k1_factrl
mpfr_set_si(tmk,length(c)+1-k)
mpfr_exp(c[k],tmk)
mpfr_set_d(p,k-1.5)
mpfr_pow(p,tmk,p)
mpfr_div(p,p,k1_factrl)
mpfr_mul(c[k],c[k],p)
-- k1_factrl *= -(k-1)
mpfr_mul_si(k1_factrl,k1_factrl,-(k-1))
end for
end if
accm = mpfr_init_set(accm)
for k=2 to length(c) do
-- accm += c[k]/(z+k-1)
mpfr ck = mpfr_init_set(c[k]),
zk = mpfr_init(z+k-1)
mpfr_div(ck,ck,zk)
mpfr_add(accm,accm,ck)
end for
atom zc = z+length(c)
-- accm *= exp(-zc)*power(zc,z+0.5) -- Gamma(z+1)
mpfr ez = mpfr_init(-zc),
p = mpfr_init(zc),
zh = mpfr_init(z+0.5)
mpfr_exp(ez,ez)
mpfr_pow(p,p,zh)
mpfr_mul(accm,accm,ez)
mpfr_mul(accm,accm,p)
-- return accm/z
mpfr_set_d(ez,z)
mpfr_div(accm,accm,ez)
return accm
end function
function gamma2(atom z)
mpfr r = mpfr_init(z)
mpfr_gamma(r,r)
return r
end function
constant FMT = "%43.40Rf"
procedure sq(mpfr x, integer n, d=1)
mpfr p = mpfr_init_set(x)
mpfr_mul_si(p,p,n)
mpfr_div_si(p,p,d)
mpfr_mul(p,p,p)
string xs = mpfr_sprintf(FMT,x),
ps = mpfr_sprintf(FMT,p)
printf(1,"%s,%s\n",{xs,ps})
end procedure
procedure si(mpfr x)
string xs = mpfr_sprintf(FMT,x)
printf(1,"%s\n",trim_tail(xs,".0"))
end procedure
sq(gamma(-3/2),3,4)
sq(gamma(-1/2),-1,2)
sq(gamma(1/2),1)
si(gamma(1))
sq(gamma(3/2),2)
si(gamma(2))
sq(gamma(5/2),4,3)
si(gamma(3))
sq(gamma(7/2),8,15)
si(gamma(4))
puts(1,"mpfr_gamma():\n")
sq(gamma2(-3/2),3,4)
sq(gamma2(-1/2),-1,2)
sq(gamma2(1/2),1)
si(gamma2(1))
sq(gamma2(3/2),2)
si(gamma2(2))
sq(gamma2(5/2),4,3)
si(gamma2(3))
sq(gamma2(7/2),8,15)
si(gamma2(4))

0
Task/Gamma-function/Python/gamma-function.py → Task/Gamma-function/Python/gamma-function-1.py
View file

82
Task/Gamma-function/Python/gamma-function-2.py Normal file
View file

@ -0,0 +1,82 @@
'''Gamma function'''
from functools import reduce
# gamma_ :: [Float] -> Float -> Float
def gamma_(tbl):
'''Gamma function.'''
def go(x):
y = float(x) - 1.0
return 1.0 / reduce(
lambda a, x: a * y + x,
tbl[-2::-1],
tbl[-1]
)
return lambda x: go(x)
# TBL :: [Float]
TBL = [
1.00000000000000000000, 0.57721566490153286061,
-0.65587807152025388108, -0.04200263503409523553,
0.16653861138229148950, -0.04219773455554433675,
-0.00962197152787697356, 0.00721894324666309954,
-0.00116516759185906511, -0.00021524167411495097,
0.00012805028238811619, -0.00002013485478078824,
-0.00000125049348214267, 0.00000113302723198170,
-0.00000020563384169776, 0.00000000611609510448,
0.00000000500200764447, -0.00000000118127457049,
0.00000000010434267117, 0.00000000000778226344,
-0.00000000000369680562, 0.00000000000051003703,
-0.00000000000002058326, -0.00000000000000534812,
0.00000000000000122678, -0.00000000000000011813,
0.00000000000000000119, 0.00000000000000000141,
-0.00000000000000000023, 0.00000000000000000002
]
# TEST ----------------------------------------------------
# main :: IO()
def main():
'''Gamma function over a range of values.'''
gamma = gamma_(TBL)
print(
fTable(' i -> gamma(i/3):\n')(repr)(lambda x: "%0.7e" % x)(
lambda x: gamma(x / 3.0)
)(enumFromTo(1)(10))
)
# GENERIC -------------------------------------------------
# enumFromTo :: (Int, Int) -> [Int]
def enumFromTo(m):
'''Integer enumeration from m to n.'''
return lambda n: list(range(m, 1 + n))
# FORMATTING -------------------------------------------------
# fTable :: String -> (a -> String) ->
# (b -> String) -> (a -> b) -> [a] -> String
def fTable(s):
'''Heading -> x display function -> fx display function ->
f -> xs -> tabular string.
'''
def go(xShow, fxShow, f, xs):
ys = [xShow(x) for x in xs]
w = max(map(len, ys))
return s + '\n' + '\n'.join(map(
lambda x, y: y.rjust(w, ' ') + ' -> ' + fxShow(f(x)),
xs, ys
))
return lambda xShow: lambda fxShow: lambda f: lambda xs: go(
xShow, fxShow, f, xs
)
# MAIN ---
if __name__ == '__main__':
main()

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

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

@ -0,0 +1,69 @@
/*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