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

A-M baby

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 21:29:02 -07:00
parent 764da6cbbb
commit db842d013d
19005 changed files with 197040 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

10
Task/Gamma-function/0DESCRIPTION Normal file
View file

@ -0,0 +1,10 @@
{{omit from|GAP}}
Implement one algorithm (or more) to compute the [[wp:Gamma function|Gamma]] (<math>\Gamma</math>) function (in the real field only). If your language has the function as builtin or you know a library which has it, compare your implementation's results with the results of the builtin/library function.
The Gamma function can be defined as:
:<math>\Gamma(x) = \displaystyle\int_0^\infty t^{x-1}e^{-t} dt</math>
This suggests a straightforward (but inefficient) way of computing the <math>\Gamma</math> through numerical integration.
Better suggested methods:
* [[wp:Lanczos approximation|Lanczos approximation]]
* [[wp:Stirling's approximation|Stirling's approximation]]

2
Task/Gamma-function/1META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
note: Mathematical operations

131
Task/Gamma-function/ALGOL-68/gamma-function.alg Normal file
View file

@ -0,0 +1,131 @@
# Coefficients used by the GNU Scientific Library #
[]LONG REAL p = ( LONG 0.99999 99999 99809 93,
LONG 676.52036 81218 851,
-LONG 1259.13921 67224 028,
LONG 771.32342 87776 5313,
-LONG 176.61502 91621 4059,
LONG 12.50734 32786 86905,
-LONG 0.13857 10952 65720 12,
LONG 9.98436 95780 19571 6e-6,
LONG 1.50563 27351 49311 6e-7);
PROC lanczos gamma = (LONG REAL in z)LONG REAL: (
# Reflection formula #
LONG REAL z := in z;
IF z < LONG 0.5 THEN
long pi / (long sin(long pi*z)*lanczos gamma(1-z))
ELSE
z -:= 1;
LONG REAL x := p[1];
FOR i TO UPB p - 1 DO x +:= p[i+1]/(z+i) OD;
LONG REAL t = z + UPB p - LONG 1.5;
long sqrt(2*long pi) * t**(z+LONG 0.5) * long exp(-t) * x
FI
);
PROC taylor gamma = (LONG REAL x)LONG REAL:
BEGIN # good for values between 0 and 1 #
[]LONG REAL a =
( LONG 1.00000 00000 00000 00000,
LONG 0.57721 56649 01532 86061,
-LONG 0.65587 80715 20253 88108,
-LONG 0.04200 26350 34095 23553,
LONG 0.16653 86113 82291 48950,
-LONG 0.04219 77345 55544 33675,
-LONG 0.00962 19715 27876 97356,
LONG 0.00721 89432 46663 09954,
-LONG 0.00116 51675 91859 06511,
-LONG 0.00021 52416 74114 95097,
LONG 0.00012 80502 82388 11619,
-LONG 0.00002 01348 54780 78824,
-LONG 0.00000 12504 93482 14267,
LONG 0.00000 11330 27231 98170,
-LONG 0.00000 02056 33841 69776,
LONG 0.00000 00061 16095 10448,
LONG 0.00000 00050 02007 64447,
-LONG 0.00000 00011 81274 57049,
LONG 0.00000 00001 04342 67117,
LONG 0.00000 00000 07782 26344,
-LONG 0.00000 00000 03696 80562,
LONG 0.00000 00000 00510 03703,
-LONG 0.00000 00000 00020 58326,
-LONG 0.00000 00000 00005 34812,
LONG 0.00000 00000 00001 22678,
-LONG 0.00000 00000 00000 11813,
LONG 0.00000 00000 00000 00119,
LONG 0.00000 00000 00000 00141,
-LONG 0.00000 00000 00000 00023,
LONG 0.00000 00000 00000 00002
);
LONG REAL y = x - 1;
LONG REAL sum := a [UPB a];
FOR n FROM UPB a - 1 DOWNTO LWB a DO
sum := sum * y + a [n]
OD;
1/sum
END # taylor gamma #;
LONG REAL long e = long exp(1);
PROC sterling gamma = (LONG REAL n)LONG REAL:
( # improves for values much greater then 1 #
long sqrt(2*long pi/n)*(n/long e)**n
);
PROC factorial = (LONG INT n)LONG REAL:
(
IF n=0 OR n=1 THEN 1
ELIF n=2 THEN 2
ELSE n*factorial(n-1) FI
);
REF[]LONG REAL fm := NIL;
PROC sponge gamma = (LONG REAL x)LONG REAL:
(
INT a = 12; # alter to get required precision #
REF []LONG REAL fm := NIL;
LONG REAL res;
IF fm :=: REF[]LONG REAL(NIL) THEN
fm := HEAP[0:a-1]LONG REAL;
fm[0] := long sqrt(LONG 2*long pi);
FOR k TO a-1 DO
fm[k] := (((k-1) MOD 2=0) | 1 | -1) * long exp(a-k) *
(a-k) **(k-LONG 0.5) / factorial(k-1)
OD
FI;
res := fm[0];
FOR k TO a-1 DO
res +:= fm[k] / ( x + k )
OD;
res *:= long exp(-(x+a)) * (x+a)**(x + LONG 0.5);
res/x
);
FORMAT real fmt = $g(-real width, real width - 2)$;
FORMAT long real fmt16 = $g(-17, 17 - 2)$; # accurate to about 16 decimal places #
[]STRING methods = ("Genie", "Lanczos", "Sponge", "Taylor","Stirling");
printf(($11xg12xg12xg13xg13xgl$,methods));
FORMAT sample fmt = $"gamma("g(-3,1)")="f(real fmt)n(UPB methods-1)(", "f(long real fmt16))l$;
FORMAT sqr sample fmt = $"gamma("g(-3,1)")**2="f(real fmt)n(UPB methods-1)(", "f(long real fmt16))l$;
FORMAT sample exp fmt = $"gamma("g(-3)")="g(-15,11,0)n(UPB methods-1)(","g(-18,14,0))l$;
PROC sample = (LONG REAL x)[]LONG REAL:
(gamma(SHORTEN x), lanczos gamma(x), sponge gamma(x), taylor gamma(x), sterling gamma(x));
FOR i FROM 1 TO 20 DO
LONG REAL x = i / LONG 10;
printf((sample fmt, x, sample(x)));
IF i = 5 THEN # insert special case of a half #
printf((sqr sample fmt,
x, gamma(SHORTEN x)**2, lanczos gamma(x)**2, sponge gamma(x)**2,
taylor gamma(x)**2, sterling gamma(x)**2))
FI
OD;
FOR x FROM 10 BY 10 TO 70 DO
printf((sample exp fmt, x, sample(x)))
OD

41
Task/Gamma-function/Ada/gamma-function-1.ada Normal file
View file

@ -0,0 +1,41 @@
function Gamma (X : Long_Float) return Long_Float is
A : constant array (0..29) of Long_Float :=
( 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
);
Y : constant Long_Float := X - 1.0;
Sum : Long_Float := A (A'Last);
begin
for N in reverse A'First..A'Last - 1 loop
Sum := Sum * Y + A (N);
end loop;
return 1.0 / Sum;
end Gamma;

9
Task/Gamma-function/Ada/gamma-function-2.ada Normal file
View file

@ -0,0 +1,9 @@
with Ada.Text_IO; use Ada.Text_IO;
with Gamma;
procedure Test_Gamma is
begin
for I in 1..10 loop
Put_Line (Long_Float'Image (Gamma (Long_Float (I) / 3.0)));
end loop;
end Test_Gamma;

82
Task/Gamma-function/AutoHotkey/gamma-function.ahk Normal file
View file

@ -0,0 +1,82 @@
/*
Here is the upper incomplete Gamma function. Omitting or setting
the second parameter to 0 we get the (complete) Gamma function.
The code is based on: "Computation of Special Functions" Zhang and Jin,
John Wiley and Sons, 1996
*/
SetFormat FloatFast, 0.9e
Loop 10
MsgBox % GAMMA(A_Index/3) "`n" GAMMA(A_Index*10)
GAMMA(a,x=0) { ; upper incomplete gamma: Integral(t**(a-1)*e**-t, t = x..inf)
If (a > 171 || x < 0)
Return 2.e308 ; overflow
xam := x > 0 ? -x+a*ln(x) : 0
If (xam > 700)
Return 2.e308 ; overflow
If (x > 1+a) { ; no need for gamma(a)
t0 := 0, k := 60
Loop 60
t0 := (k-a)/(1+k/(x+t0)), --k
Return exp(xam) / (x+t0)
}
r := 1, ga := 1.0 ; compute ga = gamma(a) ...
If (a = round(a)) ; if integer: factorial
If (a > 0)
Loop % a-1
ga *= A_Index
Else ; negative integer
ga := 1.7976931348623157e+308 ; Dmax
Else { ; not integer
If (abs(a) > 1) {
z := abs(a)
m := floor(z)
Loop %m%
r *= (z-A_Index)
z -= m
}
Else
z := a
gr := ((((((((((((((((((((((( 0.14e-14
*z - 0.54e-14) *z - 0.206e-13) *z + 0.51e-12)
*z - 0.36968e-11) *z + 0.77823e-11) *z + 0.1043427e-9)
*z - 0.11812746e-8) *z + 0.50020075e-8) *z + 0.6116095e-8)
*z - 0.2056338417e-6) *z + 0.1133027232e-5) *z - 0.12504934821e-5)
*z - 0.201348547807e-4) *z + 0.1280502823882e-3) *z - 0.2152416741149e-3)
*z - 0.11651675918591e-2) *z + 0.7218943246663e-2) *z - 0.9621971527877e-2)
*z - 0.421977345555443e-1) *z + 0.1665386113822915) *z - 0.420026350340952e-1)
*z - 0.6558780715202538) *z + 0.5772156649015329) *z + 1
ga := 1.0/(gr*z) * r
If (a < -1)
ga := -3.1415926535897931/(a*ga*sin(3.1415926535897931*a))
}
If (x = 0) ; complete gamma requested
Return ga
s := 1/a ; here x <= 1+a
r := s
Loop 60 {
r *= x/(a+A_Index)
s += r
If (abs(r/s) < 1.e-15)
break
}
Return ga - exp(xam)*s
}
/*
The 10 results shown:
2.678938535e+000 1.354117939e+000 1.0 8.929795115e-001 9.027452930e-001
3.628800000e+005 1.216451004e+017 8.841761994e+030 2.039788208e+046 6.082818640e+062
1.000000000e+000 1.190639348e+000 1.504575489e+000 2.000000000e+000 2.778158479e+000
1.386831185e+080 1.711224524e+098 8.946182131e+116 1.650795516e+136 9.332621544e+155
*/

23
Task/Gamma-function/BBC-BASIC/gamma-function.bbc Normal file
View file

@ -0,0 +1,23 @@
*FLOAT64
INSTALL @lib$+"FNUSING"
FOR x = 0.1 TO 2.05 STEP 0.1
PRINT FNusing("#.#",x), FNusing("##.############", FNgamma(x))
NEXT
END
DEF FNgamma(z) = EXP(FNlngamma(z))
DEF FNlngamma(z)
LOCAL a, b, i%, lz()
DIM lz(6)
lz() = 1.000000000190015, 76.18009172947146, -86.50532032941677, \
\ 24.01409824083091, -1.231739572450155, 0.0012086509738662, -0.000005395239385
IF z < 0.5 THEN = LN(PI / SIN(PI * z)) - FNlngamma(1.0 - z)
z -= 1.0
b = z + 5.5
a = lz(0)
FOR i% = 1 TO 6
a += lz(i%) / (z + i%)
NEXT
= (LNSQR(2*PI) + LN(a) - b) + LN(b) * (z+0.5)

52
Task/Gamma-function/C/gamma-function.c Normal file
View file

@ -0,0 +1,52 @@
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <gsl/gsl_sf_gamma.h>
#ifndef M_PI
#define M_PI 3.14159265358979323846
#endif
/* very simple approximation */
double st_gamma(double x)
{
return sqrt(2.0*M_PI/x)*pow(x/M_E, x);
}
#define A 12
double sp_gamma(double z)
{
const int a = A;
static double c_space[A];
static double *c = NULL;
int k;
double accm;
if ( c == NULL ) {
double k1_factrl = 1.0; /* (k - 1)!*(-1)^k with 0!==1*/
c = c_space;
c[0] = sqrt(2.0*M_PI);
for(k=1; k < a; k++) {
c[k] = exp(a-k) * pow(a-k, k-0.5) / k1_factrl;
k1_factrl *= -k;
}
}
accm = c[0];
for(k=1; k < a; k++) {
accm += c[k] / ( z + k );
}
accm *= exp(-(z+a)) * pow(z+a, z+0.5); /* Gamma(z+1) */
return accm/z;
}
int main()
{
double x;
printf("%15s%15s%15s%15s\n", "Stirling", "Spouge", "GSL", "libm");
for(x=1.0; x <= 10.0; x+=1.0) {
printf("%15.8lf%15.8lf%15.8lf%15.8lf\n", st_gamma(x/3.0), sp_gamma(x/3.0),
gsl_sf_gamma(x/3.0), tgamma(x/3.0));
}
return 0;
}

15
Task/Gamma-function/Clojure/gamma-function-1.clj Normal file
View file

@ -0,0 +1,15 @@
(defn gamma
"Returns Gamma(z + 1 = number) using Lanczos approximation."
[number]
(if (< number 0.5)
(/ Math/PI (* (Math/sin (* Math/PI number))
(gamma (- 1 number))))
(let [n (dec number)
c [0.99999999999980993 676.5203681218851 -1259.1392167224028
771.32342877765313 -176.61502916214059 12.507343278686905
-0.13857109526572012 9.9843695780195716e-6 1.5056327351493116e-7]]
(* (Math/sqrt (* 2 Math/PI))
(Math/pow (+ n 7 0.5) (+ n 0.5))
(Math/exp (- (+ n 7 0.5)))
(+ (first c)
(apply + (map-indexed #(/ %2 (+ n %1 1)) (next c))))))))

1
Task/Gamma-function/Clojure/gamma-function-2.clj Normal file
View file

@ -0,0 +1 @@
(map #(printf "%.1f %.4f\n" % (gamma %)) (map #(float (/ % 10)) (range 1 31)))

26
Task/Gamma-function/Common-Lisp/gamma-function.lisp Normal file
View file

@ -0,0 +1,26 @@
; Taylor series coefficients
(defconstant tcoeff
'( 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))
; number of coefficients
(defconstant numcoeff (length tcoeff))
(defun gamma (x)
(let ((y (- x 1.0))
(sum (nth (- numcoeff 1) tcoeff)))
(loop for i from (- numcoeff 2) downto 0 do
(setf sum (+ (* sum y) (nth i tcoeff))))
(/ 1.0 sum)))
(loop for i from 1 to 10
do (
format t "~12,10f~%" (gamma (/ i 3.0))))

28
Task/Gamma-function/D/gamma-function.d Normal file
View file

@ -0,0 +1,28 @@
import std.stdio, std.mathspecial;
real myGamma(in real x) pure nothrow {
static immutable real[30] table = [
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];
immutable real y = x - 1.0L;
real sm = table[$ - 1];
foreach_reverse (immutable an; table[0 .. $ - 1])
sm = sm * y + an;
return 1.0L / sm;
}
void main() {
foreach (immutable i; 1 .. 11) {
immutable real x = i / 3.0L;
writefln("%f: %20.19e %20.19e", x, myGamma(x), gamma(x));
}
}

98
Task/Gamma-function/Fortran/gamma-function.f Normal file
View file

@ -0,0 +1,98 @@
program ComputeGammaInt
implicit none
integer :: i
write(*, "(3A15)") "Simpson", "Lanczos", "Builtin"
do i=1, 10
write(*, "(3F15.8)") my_gamma(i/3.0), lacz_gamma(i/3.0), gamma(i/3.0)
end do
contains
pure function intfuncgamma(x, y) result(z)
real :: z
real, intent(in) :: x, y
z = x**(y-1.0) * exp(-x)
end function intfuncgamma
function my_gamma(a) result(g)
real :: g
real, intent(in) :: a
real, parameter :: small = 1.0e-4
integer, parameter :: points = 100000
real :: infty, dx, p, sp(2, points), x
integer :: i
logical :: correction
x = a
correction = .false.
! value with x<1 gives \infty, so we use
! \Gamma(x+1) = x\Gamma(x)
! to avoid the problem
if ( x < 1.0 ) then
correction = .true.
x = x + 1
end if
! find a "reasonable" infinity...
! we compute this integral indeed
! \int_0^M dt t^{x-1} e^{-t}
! where M is such that M^{x-1} e^{-M} ≤ \epsilon
infty = 1.0e4
do while ( intfuncgamma(infty, x) > small )
infty = infty * 10.0
end do
! using simpson
dx = infty/real(points)
sp = 0.0
forall(i=1:points/2-1) sp(1, 2*i) = intfuncgamma(2.0*(i)*dx, x)
forall(i=1:points/2) sp(2, 2*i - 1) = intfuncgamma((2.0*(i)-1.0)*dx, x)
g = (intfuncgamma(0.0, x) + 2.0*sum(sp(1,:)) + 4.0*sum(sp(2,:)) + &
intfuncgamma(infty, x))*dx/3.0
if ( correction ) g = g/a
end function my_gamma
recursive function lacz_gamma(a) result(g)
real, intent(in) :: a
real :: g
real, parameter :: pi = 3.14159265358979324
integer, parameter :: cg = 7
! these precomputed values are taken by the sample code in Wikipedia,
! and the sample itself takes them from the GNU Scientific Library
real, dimension(0:8), parameter :: p = &
(/ 0.99999999999980993, 676.5203681218851, -1259.1392167224028, &
771.32342877765313, -176.61502916214059, 12.507343278686905, &
-0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7 /)
real :: t, w, x
integer :: i
x = a
if ( x < 0.5 ) then
g = pi / ( sin(pi*x) * lacz_gamma(1.0-x) )
else
x = x - 1.0
t = p(0)
do i=1, cg+2
t = t + p(i)/(x+real(i))
end do
w = x + real(cg) + 0.5
g = sqrt(2.0*pi) * w**(x+0.5) * exp(-w) * t
end if
end function lacz_gamma
end program ComputeGammaInt

27
Task/Gamma-function/Go/gamma-function.go Normal file
View file

@ -0,0 +1,27 @@
package main
import (
"fmt"
"math"
)
func main() {
fmt.Println(" x math.Gamma Lanczos7")
for _, x := range []float64{-.5, .1, .5, 1, 1.5, 2, 3, 10, 140, 170} {
fmt.Printf("%5.1f %24.16g %24.16g\n", x, math.Gamma(x), lanczos7(x))
}
}
func lanczos7(z float64) float64 {
t := z + 6.5
x := .99999999999980993 +
676.5203681218851/z -
1259.1392167224028/(z+1) +
771.32342877765313/(z+2) -
176.61502916214059/(z+3) +
12.507343278686905/(z+4) -
.13857109526572012/(z+5) +
9.9843695780195716e-6/(z+6) +
1.5056327351493116e-7/(z+7)
return math.Sqrt2 * math.SqrtPi * math.Pow(t, z-.5) * math.Exp(-t) * x
}

14
Task/Gamma-function/Groovy/gamma-function.groovy Normal file
View file

@ -0,0 +1,14 @@
a = [ 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].reverse()
def gamma = { 1.0 / a.inject(0) { sm, a_i -> sm * (it - 1) + a_i } }
(1..10).each{ printf("% 1.9e\n", gamma(it / 3.0)) }

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

@ -0,0 +1,10 @@
cof :: [Double]
cof = [76.18009172947146,-86.50532032941677,24.01409824083091,-1.231739572450155,0.001208650973866179,-0.000005395239384953]
ser :: Double
ser = 1.000000000190015
gammaln :: Double -> Double
gammaln xx = let tmp' = (xx+5.5) - (xx+0.5)*log(xx+5.5)
ser' = ser + sum (zipWith (/) cof [xx+1..])
in -tmp' + log(2.5066282746310005 * ser' / xx)

1
Task/Gamma-function/J/gamma-function-1.j Normal file
View file

@ -0,0 +1 @@
gamma=: !@<:

3
Task/Gamma-function/J/gamma-function-2.j Normal file
View file

@ -0,0 +1,3 @@
sbase =: %:@(2p1&%) * %&1x1 ^ ]
scorr =: 1 1r12 1r288 _139r51840 _571r2488320&p.@%
stirlg=: sbase * scorr

6
Task/Gamma-function/J/gamma-function-3.j Normal file
View file

@ -0,0 +1,6 @@
(,. stirlg ,. gamma) 10 1p1 1x1 1.5 1
10 362880 362880
3.14159 2.28803 2.28804
2.71828 1.56746 1.56747
1.5 0.886155 0.886227
1 0.999499 1

31
Task/Gamma-function/Java/gamma-function.java Normal file
View file

@ -0,0 +1,31 @@
public class GammaFunction {
public double st_gamma(double x){
return Math.sqrt(2*Math.PI/x)*Math.pow((x/Math.E), x);
}
public double la_gamma(double x){
double[] p = {0.99999999999980993, 676.5203681218851, -1259.1392167224028,
771.32342877765313, -176.61502916214059, 12.507343278686905,
-0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7};
int g = 7;
if(x < 0.5) return Math.PI / (Math.sin(Math.PI * x)*la_gamma(1-x));
x -= 1;
double a = p[0];
double t = x+g+0.5;
for(int i = 1; i < p.length; i++){
a += p[i]/(x+i);
}
return Math.sqrt(2*Math.PI)*Math.pow(t, x+0.5)*Math.exp(-t)*a;
}
public static void main(String[] args) {
GammaFunction test = new GammaFunction();
System.out.println("Gamma \t\tStirling \t\tLanczos");
for(double i = 1; i <= 20; i += 1){
System.out.println("" + i/10.0 + "\t\t" + test.st_gamma(i/10.0) + "\t" + test.la_gamma(i/10.0));
}
}
}

11
Task/Gamma-function/Lua/gamma-function.lua Normal file
View file

@ -0,0 +1,11 @@
gamma, coeff, quad, qui, set = 0.577215664901, -0.65587807152056, -0.042002635033944, 0.16653861138228, -0.042197734555571
function recigamma(z)
return z + gamma * z^2 + coeff * z^3 + quad * z^4 + qui * z^5 + set * z^6
end
function gammafunc(z)
if z == 1 then return 1
elseif math.abs(z) <= 0.5 then return 1 / recigamma(z)
else return (z - 1) * gammafunc(z-1)
end
end

1
Task/Gamma-function/Mathematica/gamma-function.mathematica Normal file
View file

@ -0,0 +1 @@
Gamma[x]

21
Task/Gamma-function/Maxima/gamma-function.maxima Normal file
View file

@ -0,0 +1,21 @@
fpprec: 30$
gamma_coeff(n) := block([a: makelist(1, n)],
a[2]: bfloat(%gamma),
for k from 3 thru n do
a[k]: bfloat((sum((-1)^j * zeta(j) * a[k - j], j, 2, k - 1) - a[2] * a[k - 1]) / (1 - k * a[1])),
a)$
poleval(a, x) := block([y: 0],
for k from length(a) thru 1 step -1 do
y: y * x + a[k],
y)$
gc: gamma_coeff(20)$
gamma_approx(x) := block([y: 1],
while x > 2 do (x: x - 1, y: y * x),
y / (poleval(gc, x - 1)))$
gamma_approx(12.3b0) - gamma(12.3b0);
/* -9.25224705314470500985141176997b-15 */

37
Task/Gamma-function/Modula-3/gamma-function.mod3 Normal file
View file

@ -0,0 +1,37 @@
MODULE Gamma EXPORTS Main;
FROM IO IMPORT Put;
FROM Fmt IMPORT Extended, Style;
PROCEDURE Taylor(x: EXTENDED): EXTENDED =
CONST a = ARRAY [0..29] OF EXTENDED {
1.00000000000000000000X0, 0.57721566490153286061X0,
-0.65587807152025388108X0, -0.04200263503409523553X0,
0.16653861138229148950X0, -0.04219773455554433675X0,
-0.00962197152787697356X0, 0.00721894324666309954X0,
-0.00116516759185906511X0, -0.00021524167411495097X0,
0.00012805028238811619X0, -0.00002013485478078824X0,
-0.00000125049348214267X0, 0.00000113302723198170X0,
-0.00000020563384169776X0, 0.00000000611609510448X0,
0.00000000500200764447X0, -0.00000000118127457049X0,
0.00000000010434267117X0, 0.00000000000778226344X0,
-0.00000000000369680562X0, 0.00000000000051003703X0,
-0.00000000000002058326X0, -0.00000000000000534812X0,
0.00000000000000122678X0, -0.00000000000000011813X0,
0.00000000000000000119X0, 0.00000000000000000141X0,
-0.00000000000000000023X0, 0.00000000000000000002X0 };
VAR y := x - 1.0X0;
sum := a[LAST(a)];
BEGIN
FOR i := LAST(a) - 1 TO FIRST(a) BY -1 DO
sum := sum * y + a[i];
END;
RETURN 1.0X0 / sum;
END Taylor;
BEGIN
FOR i := 1 TO 10 DO
Put(Extended(Taylor(FLOAT(i, EXTENDED) / 3.0X0), style := Style.Sci) & "\n");
END;
END Gamma.

44
Task/Gamma-function/Perl/gamma-function.pl Normal file
View file

@ -0,0 +1,44 @@
my @coeff = reverse <DATA>;
sub Gamma {
my $x = shift;
my $s;
$s = $s*($x-1) + $_ for @coeff;
return 1 / $s;
}
for (1 .. 10) {
$_ /= 3;
printf "Gamma(%.5f) ≈ %.14e\n", $_, Gamma($_);
}
__DATA__
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

20
Task/Gamma-function/PicoLisp/gamma-function.l Normal file
View file

@ -0,0 +1,20 @@
(scl 28)
(de *A
~(flip
(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 ) ) )
(de gamma (X)
(let (Y (- X 1.0) Sum (car *A))
(for A (cdr *A)
(setq Sum (+ A (*/ Sum Y 1.0))) )
(*/ 1.0 1.0 Sum) ) )

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

@ -0,0 +1,22 @@
_a = ( 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
)
def gamma (x):
y = float(x) - 1.0;
sm = _a[-1];
for an in _a[-2::-1]:
sm = sm * y + an;
return 1.0 / sm;
if __name__ == '__main__':
for i in range(1,11):
print " %20.14e" % gamma(i/3.0)

50
Task/Gamma-function/R/gamma-function.r Normal file
View file

@ -0,0 +1,50 @@
stirling <- function(z) sqrt(2*pi/z) * (exp(-1)*z)^z
nemes <- function(z) sqrt(2*pi/z) * (exp(-1)*(z + (12*z - (10*z)^-1)^-1))^z
lanczos <- function(z)
{
if(length(z) > 1)
{
sapply(z, lanczos)
} else
{
g <- 7
p <- c(0.99999999999980993, 676.5203681218851, -1259.1392167224028,
771.32342877765313, -176.61502916214059, 12.507343278686905,
-0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7)
z <- as.complex(z)
if(Re(z) < 0.5)
{
pi / (sin(pi*z) * lanczos(1-z))
} else
{
z <- z - 1
x <- p[1] + sum(p[-1]/seq.int(z+1, z+g+1))
tt <- z + g + 0.5
sqrt(2*pi) * tt^(z+0.5) * exp(-tt) * x
}
}
}
spouge <- function(z, a=49)
{
if(length(z) > 1)
{
sapply(z, spouge)
} else
{
z <- z-1
k <- seq.int(1, a-1)
ck <- rep(c(1, -1), len=a-1) / factorial(k-1) * (a-k)^(k-0.5) * exp(a-k)
(z + a)^(z+0.5) * exp(-z - a) * (sqrt(2*pi) + sum(ck/(z+k)))
}
}
# Checks
z <- (1:10)/3
all.equal(gamma(z), stirling(z)) # Mean relative difference: 0.07181942
all.equal(gamma(z), nemes(z)) # Mean relative difference: 0.003460549
all.equal(as.complex(gamma(z)), lanczos(z)) # TRUE
all.equal(gamma(z), spouge(z)) # TRUE
data.frame(z=z, stirling=stirling(z), nemes=nemes(z), lanczos=lanczos(z), spouge=spouge(z), builtin=gamma(z))

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

@ -0,0 +1,70 @@
/*REXX pgm calculates GAMMA using Taylor series coefficients, ≈80 digits*/
/*The GAMMA function symbol is the Greek cap letter: Γ */
numeric digits 82 /*able to use extended precision.*/
parse arg y . /*allow specification of Γ arg.*/
/*either show a range or a */
do j=word(y 1,1) to word(y 9,1) /* single gamma value(s). */
say 'gamma('j") =" gamma(j) /*compute gamma of J and display.*/
end /*j*/
exit /*stick a fork in it, we're done.*/
exit /*stick a fork in it, we're done.*/
/*───────────────────────────────────GAMMA subroutine=──────────────────*/
gamma: procedure; parse arg x; xm=x-1; sum=0
#.1= 1 /*#.2 is the Euler-Mascheroni constant.*/
/*coefficients thanks to: Arne Fransén and Staffan Wrigge.*/
#.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
do j=52 by -1 to 1
sum = sum * xm + #.j
end /*j*/
return 1/sum

17
Task/Gamma-function/Ruby/gamma-function.rb Normal file
View file

@ -0,0 +1,17 @@
$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 ]
def gamma(x)
y = Float(x) - 1
1.0 / $a.reverse.inject {|sum, an| sum * y + an}
end
(1..10).each {|i| puts format("%.14e", gamma(i/3.0))}

26
Task/Gamma-function/Scala/gamma-function.scala Normal file
View file

@ -0,0 +1,26 @@
import java.util.Locale._
object Gamma {
def stGamma(x:Double):Double=math.sqrt(2*math.Pi/x)*math.pow((x/math.E), x)
def laGamma(x:Double):Double={
val p=Seq(676.5203681218851, -1259.1392167224028, 771.32342877765313,
-176.61502916214059, 12.507343278686905, -0.13857109526572012,
9.9843695780195716e-6, 1.5056327351493116e-7)
if(x < 0.5) {
math.Pi/(math.sin(math.Pi*x)*laGamma(1-x))
} else {
val x2=x-1
val t=x2+7+0.5
val a=p.zipWithIndex.foldLeft(0.99999999999980993)((r,v) => r+v._1/(x2+v._2+1))
math.sqrt(2*math.Pi)*math.pow(t, x2+0.5)*math.exp(-t)*a
}
}
def main(args: Array[String]): Unit = {
println("Gamma Stirling Lanczos")
for(x <- 0.1 to 2.0 by 0.1)
println("%.1f -> %.16f %.16f".formatLocal(ENGLISH, x, stGamma(x), laGamma(x)))
}
}

35
Task/Gamma-function/Tcl/gamma-function.tcl Normal file
View file

@ -0,0 +1,35 @@
package require math
package require math::calculus
# gamma(1) and gamma(1.5)
set f 1.0
set f2 [expr {sqrt(acos(-1.))/2.}]
for {set x 1.0} {$x <= 10.0} {set x [expr {$x + 0.5}]} {
# method 1 - numerical integration, Romberg's method, special
# case for an improper integral
set g1 [math::calculus::romberg \
[list apply {{x t} {expr {$t ** ($x-1) * exp(-$t)}}} $x] \
0 1 -relerror 1e-8]
set g2 [math::calculus::romberg_infinity \
[list apply {{x t} {expr {$t ** ($x-1) * exp(-$t)}}} $x] \
1 Inf -relerror 1e-8]
set gamma [expr {[lindex $g1 0] + [lindex $g2 0]}]
# method 2 - library function
set libgamma [expr {exp([math::ln_Gamma $x])}]
# method 3 - special forms for integer and half-integer arguments
if {$x == entier($x)} {
puts [format {%4.1f %13.6f %13.6f %13.6f} $x $gamma $libgamma $f]
set f [expr $f * $x]
} else {
puts [format {%4.1f %13.6f %13.6f %13.6f} $x $gamma $libgamma $f2]
set f2 [expr $f2 * $x]
}
}