langs a-z

Task/Gamma-function/OCaml/gamma-function.ocaml

@@ -0,0 +1,63 @@
+let e = exp 1.
+let pi = 4. *. atan 1.
+let sqrttwopi = sqrt (2. *. pi)
+
+module Lanczos = struct
+  (* Lanczos method *)
+  (* Coefficients used by the GNU Scientific Library *)
+  let g = 7.
+  let c = [|0.99999999999980993; 676.5203681218851; -1259.1392167224028;
+	    771.32342877765313; -176.61502916214059; 12.507343278686905;
+	    -0.13857109526572012; 9.9843695780195716e-6; 1.5056327351493116e-7|]
+
+  let rec ag z d =
+    if d = 0 then c.(0) +. ag z 1
+    else if d < 8 then c.(d) /. (z +. float d) +. ag z (succ d)
+    else c.(d) /. (z +. float d)
+
+  let gamma z =
+    let z = z -. 1. in
+    let p = z +. g +. 0.5 in
+    sqrttwopi *. p ** (z +. 0.5) *. exp (-. p) *. ag z 0
+end
+
+module Stirling = struct
+  (* Stirling method *)
+  let gamma z =
+    sqrttwopi /. sqrt z *. (z /. e) ** z
+
+end
+
+module Stirling2 = struct
+  (* Extended Stirling method seen in Abramowitz and Stegun *)
+  let d = [|1./.12.; 1./.288.; -139./.51840.; -571./.2488320.|]
+
+  let rec corr z x n =
+    if n < Array.length d - 1 then d.(n) /. x +. corr z (x *. z) (succ n)
+    else d.(n) /. x
+
+  let gamma z = Stirling.gamma z *. (1. +. corr z z 0)
+end
+
+let mirror gma z =
+  if z > 0.5 then gma z
+  else pi /. sin (pi *. z) /. gma (1. -. z)
+
+let _ =
+  Printf.printf "z\t\tLanczos\t\tStirling\tStirling2\n";
+  for i = 1 to 20 do
+    let z = float i /. 10. in
+    Printf.printf "%-10.8g\t%10.8e\t%10.8e\t%10.8e\n"
+    		  z
+		  (mirror Lanczos.gamma z)
+		  (mirror Stirling.gamma z)
+		  (mirror Stirling2.gamma z)
+  done;
+  for i = 1 to 7 do
+    let z = 10. *. float i in
+    Printf.printf "%-10.8g\t%10.8e\t%10.8e\t%10.8e\n"
+    		  z
+		  (Lanczos.gamma z)
+		  (Stirling.gamma z)
+		  (Stirling2.gamma z)
+  done

Task/Gamma-function/Octave/gamma-function.octave

@@ -0,0 +1,22 @@
+function g = lacz_gamma(a, cg=7)
+  p = [ 0.99999999999980993, 676.5203681218851, -1259.1392167224028, \
+        771.32342877765313, -176.61502916214059, 12.507343278686905, \
+        -0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7 ];
+  x=a;
+  if ( x < 0.5 )
+    g = pi / ( sin(pi*x) * lacz_gamma(1.0-x) );
+  else
+    x = x - 1.0;
+    t = p(1);
+    for i=1:(cg+1)
+      t = t + p(i+1)/(x+double(i));
+    endfor
+    w = x + double(cg) + 0.5;
+    g = sqrt(2.0*pi) * w**(x+0.5) * exp(-w) * t;
+  endif
+endfunction
+
+
+for i = 1:10
+  printf("%f %f\n", gamma(i/3.0), lacz_gamma(i/3.0));
+endfor

Task/Gamma-function/PARI-GP/gamma-function-1.pari

@@ -0,0 +1 @@
+gamma(x)

Task/Gamma-function/PARI-GP/gamma-function-2.pari

@@ -0,0 +1 @@
+Gamma(x)=intnum(t=0,[[1],1],t^(x-1)/exp(t))

Task/Gamma-function/PARI-GP/gamma-function-3.pari

@@ -0,0 +1 @@
+Gamma(x)=intnumromb(t=0,9,t^(x-1)/exp(t),0)+intnumromb(t=9,max(x,99)^9,t^(x-1)/exp(t),2)

Task/Gamma-function/PARI-GP/gamma-function-4.pari

@@ -0,0 +1 @@
+Stirling(x)=x--;sqrt(2*Pi*x)*(x/exp(1))^x

Task/Gamma-function/PL-I/gamma-function.pli

@@ -0,0 +1,45 @@
+/* From Rosetta Fortran */
+test: procedure options (main);
+
+  declare i fixed binary;
+
+  on underflow ;
+
+  put skip list ('Lanczos', 'Builtin' );
+  do i = 1 to 10;
+     put skip list (lanczos_gamma(i/3.0q0), gamma(i/3.0q0) );
+  end;
+
+
+lanczos_gamma: procedure (a) returns (float (18)) recursive;
+    declare a float (18);
+    declare pi float (18) value (3.14159265358979324E0);
+    declare cg fixed binary initial ( 7 );
+
+    /* these precomputed values are taken by the sample code in Wikipedia, */
+    /* and the sample itself takes them from the GNU Scientific Library */
+    declare p(0:8) float (18) static initial
+         ( 0.99999999999980993e0, 676.5203681218851e0, -1259.1392167224028e0,
+         771.32342877765313e0, -176.61502916214059e0, 12.507343278686905e0,
+         -0.13857109526572012e0, 9.9843695780195716e-6, 1.5056327351493116e-7 );
+
+    declare ( t, w, x ) float (18);
+    declare i fixed binary;
+
+    x = a;
+
+    if x < 0.5 then
+       return ( pi / ( sin(pi*x) * lanczos_gamma(1.0-x) ) );
+    else
+       do;
+          x = x - 1.0;
+          t = p(0);
+          do i = 1 to cg+2;
+             t = t + p(i)/(x+i);
+          end;
+          w = x + float(cg) + 0.5;
+          return ( sqrt(2*pi) * w**(x+0.5) * exp(-w) * t );
+       end;
+  end lanczos_gamma;
+
+end test;

Task/Gamma-function/Perl-6/gamma-function.pl6

@@ -0,0 +1,18 @@
+sub Γ($x) {
+    1 / <
+	 0.00000_00000_00000_00002 -0.00000_00000_00000_00023  0.00000_00000_00000_00141
+	 0.00000_00000_00000_00119 -0.00000_00000_00000_11813  0.00000_00000_00001_22678
+	-0.00000_00000_00005_34812 -0.00000_00000_00020_58326  0.00000_00000_00510_03703
+	-0.00000_00000_03696_80562  0.00000_00000_07782_26344  0.00000_00001_04342_67117
+	-0.00000_00011_81274_57049  0.00000_00050_02007_64447  0.00000_00061_16095_10448
+	-0.00000_02056_33841_69776  0.00000_11330_27231_98170 -0.00000_12504_93482_14267
+	-0.00002_01348_54780_78824  0.00012_80502_82388_11619 -0.00021_52416_74114_95097
+	-0.00116_51675_91859_06511  0.00721_89432_46663_09954 -0.00962_19715_27876_97356
+	-0.04219_77345_55544_33675  0.16653_86113_82291_48950 -0.04200_26350_34095_23553
+	-0.65587_80715_20253_88108  0.57721_56649_01532_86061  1.00000_00000_00000_00000
+    >.reduce: * *($x-1) + *
+}
+ 
+for 1/3, 2/3 ... 10/3 {
+    printf "Γ(%.5f) ≈ %.14f\n", $_, Γ($_);
+}

Task/Gamma-function/PureBasic/gamma-function-1.purebasic

@@ -0,0 +1,82 @@
+Procedure.d Gamma(x.d) ; AKJ  01-May-10
+; Complete Gamma function for x>0 and x<2 (approx)
+; Extended outside this range via: Gamma(x+1) = x*Gamma(x)
+; Based on http://rosettacode.org/wiki/Gamma_function  [Ada]
+Protected Dim A.d(28)
+A(0) = 1.0
+A(1) = 0.5772156649015328606
+A(2) =-0.6558780715202538811
+A(3) =-0.0420026350340952355
+A(4) = 0.1665386113822914895
+A(5) =-0.0421977345555443368 ; was ...33675
+A(6) =-0.0096219715278769736
+A(7) = 0.0072189432466630995
+A(8) =-0.0011651675918590651
+A(9) =-0.0002152416741149510
+A(10) = 0.0001280502823881162
+A(11) =-0.0000201348547807882
+A(12) =-0.0000012504934821427
+A(13) = 0.0000011330272319817
+A(14) =-0.0000002056338416978
+A(15) = 0.0000000061160951045
+A(16) = 0.0000000050020076445
+A(17) =-0.0000000011812745705
+A(18) = 0.0000000001043426712
+A(19) = 0.0000000000077822634
+A(20) =-0.0000000000036968056
+A(21) = 0.0000000000005100370
+A(22) =-0.0000000000000205833
+A(23) =-0.0000000000000053481
+A(24) = 0.0000000000000012268
+A(25) =-0.0000000000000001181
+A(26) = 0.0000000000000000012
+A(27) = 0.0000000000000000014
+A(28) =-0.0000000000000000002
+;A(29) = 0.00000000000000000002
+Protected y.d, Prod.d, Sum.d, N
+If x<=0.0: ProcedureReturn 0.0: EndIf ; Error
+y = x-1.0: Prod = 1.0
+While y>=1.0
+  Prod*y: y-1.0 ; Recurse using Gamma(x+1) = x*Gamma(x)
+Wend
+Sum= A(28)
+For N = 27 To 0 Step -1
+  Sum*y+A(N)
+Next N
+If Sum=0.0: ProcedureReturn Infinity(): EndIf
+ProcedureReturn Prod / Sum
+EndProcedure
+
+Procedure.d GammLn(x.d) ; AKJ  01-May-10
+; Returns Ln(Gamma()) or 0 on error
+; Based on Numerical Recipes gamma.h
+Protected j, tmp.d, y.d, ser.d
+Protected Dim cof.d(13)
+cof(0) = 57.1562356658629235
+cof(1) = -59.5979603554754912
+cof(2) = 14.1360979747417471
+cof(3) = -0.491913816097620199
+cof(4) = 0.339946499848118887e-4
+cof(5) = 0.465236289270485756e-4
+cof(6) = -0.983744753048795646e-4
+cof(7) = 0.158088703224912494e-3
+cof(8) = -0.210264441724104883e-3
+cof(9) = 0.217439618115212643e-3
+cof(10) = -0.164318106536763890e-3
+cof(11) = 0.844182239838527433e-4
+cof(12) = -0.261908384015814087e-4
+cof(13) = 0.368991826595316234e-5
+If x<=0: ProcedureReturn 0: EndIf ; Bad argument
+y = x
+tmp = x+5.2421875
+tmp = (x+0.5)*Log(tmp)-tmp
+ser = 0.999999999999997092
+For j=0 To 13
+  y + 1: ser + cof(j)/y
+Next j
+ProcedureReturn tmp+Log(2.5066282746310005*ser/x)
+EndProcedure
+
+Procedure Factorial(x) ; AKJ  01-May-10
+  ProcedureReturn Gamma(x+1)
+EndProcedure

Task/Gamma-function/PureBasic/gamma-function-2.purebasic

@@ -0,0 +1,8 @@
+Debug "Gamma()"
+For i = 12 To 15
+  Debug StrD(i/3.0, 3)+"   "+StrD(Gamma(i/3.0))
+Next i
+Debug ""
+Debug "Ln(Gamma(5.0)) = "+StrD(GammLn(5.0), 16) ; Ln(24)
+Debug ""
+Debug "Factorial 6 = "+StrD(Factorial(6), 0) ; 72

Task/Gamma-function/Seed7/gamma-function.seed7

@@ -0,0 +1,42 @@
+$ include "seed7_05.s7i";
+  include "float.s7i";
+
+const func float: gamma (in float: X) is func
+  result
+    var float: result is 0.0;
+  local
+    const array float: A is [] (
+         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);
+    var float: Y is 0.0;
+    var float: Sum is A[maxIdx(A)];
+    var integer: N is 0;
+  begin
+    Y := X - 1.0;
+    for N range pred(maxIdx(A)) downto minIdx(A) do
+      Sum := Sum * Y + A[N];
+    end for;
+    result := 1.0 / Sum;
+  end func;
+
+const proc: main is func
+  local
+    var integer: I is 0;
+  begin
+    for I range 1 to 10 do
+      writeln((gamma(flt(I) / 3.0)) digits 15);
+    end for;
+  end func;