Data update

Task/Gamma-function/Ada/gamma-function-1.adb

@@ -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;

Task/Gamma-function/Ada/gamma-function-2.adb

@@ -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;

Task/Gamma-function/Agena/gamma-function.agena

@@ -0,0 +1,26 @@
+# Gamma function
+
+proc ln_gamma(z :: number) :: number is
+  lz := reg(1.00000000019001, 76.1800917294715, -86.5053203294168, 24.0140982408309, -1.23173957245015, 0.0012086509738662, -0.000005395239385);
+  if z < 0.5 then
+    return ln(Pi / sin(Pi * z)) - ln_gamma(1.0 - z)
+  else
+    z -:= 1.0;
+    b := z + 5.5;
+    a := lz[1];
+    for i from 2 to 7 do
+      a +:= lz[i] / (z + i - 1)
+    od;
+    return (ln(sqrt(2 * Pi)) + ln(a) - b) + ln(b) * (z + 0.5)
+  fi
+end;
+
+proc gamma(z :: number) :: number is
+  return exp(ln_gamma(z));
+end;
+
+scope
+  for x from 0.1 to 2.05 by 0.1 do
+    printf("%3.1f\t%15.12f\n", x, gamma(x))
+  od
+epocs

Task/Gamma-function/Free-Pascal-Lazarus/gamma-function.pas

@@ -0,0 +1,76 @@
+program GammaTest;
+{$mode objfpc}{$H+}
+uses SysUtils;
+
+function Gamma( x : extended) : extended;
+const COF : array [0..14] of extended =
+(  0.999999999999997092, // may as well include this in the array
+  57.1562356658629235,
+ -59.5979603554754912,
+  14.1360979747417471,
+ -0.491913816097620199,
+  0.339946499848118887e-4,
+  0.465236289270485756e-4,
+ -0.983744753048795646e-4,
+  0.158088703224912494e-3,
+ -0.210264441724104883e-3,
+  0.217439618115212643e-3,
+ -0.164318106536763890e-3,
+  0.844182239838527433e-4,
+ -0.261908384015814087e-4,
+  0.368991826595316234e-5);
+const
+  K = 2.5066282746310005;
+  PI_OVER_K = PI / K;
+var
+  j : integer;
+  tmp, w, ser : extended;
+  reflect : boolean;
+begin
+  reflect := (x < 0.5);
+  if reflect then w := 1.0 - x else w := x;
+  tmp := w + 5.2421875;
+  tmp := (w + 0.5)*Ln(tmp) - tmp;
+  ser := COF[0];
+  for j := 1 to 14 do ser := ser + COF[j]/(w + j);
+  try
+    if reflect then
+      result := PI_OVER_K * w * Exp(-tmp) / (Sin(PI*x) * ser)
+    else
+      result := K * Exp(tmp) * ser / w;
+  except
+    raise SysUtils.Exception.CreateFmt(
+        'Gamma(%g) is undefined or out of floating-point range', [x]);
+  end;
+end;
+
+// Main routine for testing the Gamma function
+var
+    x, k : extended;
+begin
+  WriteLn( 'Is it seamless at x = 1/2 ?');
+  x := 0.49999999999999;
+  WriteLn( SysUtils.Format( 'Gamma(%g) = %g', [x, Gamma(x)]));
+  x := 0.50000000000001;
+  WriteLn( SysUtils.Format( 'Gamma(%g) = %g', [x, Gamma(x)]));
+  WriteLn( 'Test a few values:');
+  WriteLn( SysUtils.Format( 'Gamma(1)   = %g', [Gamma(1)]));
+  WriteLn( SysUtils.Format( 'Gamma(2)   = %g', [Gamma(2)]));
+  WriteLn( SysUtils.Format( 'Gamma(3)   = %g', [Gamma(3)]));
+  WriteLn( SysUtils.Format( 'Gamma(10)  = %g', [Gamma(10)]));
+  WriteLn( SysUtils.Format( 'Gamma(101) = %g', [Gamma(101)]));
+  WriteLn( '      100! = 9.33262154439442E157');
+  WriteLn( SysUtils.Format( 'Gamma(1/2) = %g', [Gamma(0.5)]));
+  WriteLn( SysUtils.Format( 'Sqrt(pi)   = %g', [Sqrt(PI)]));
+  WriteLn( SysUtils.Format( 'Gamma(-7/2)       =  %g', [Gamma(-3.5)]));
+(*
+  Note here a bug or misfeature in Lazarus (doesn't occur in Delphi):
+  Putting (16.0/105.0)*Sqrt(PI) does not give the required precision.
+  We have to explicitly define the integers as extended floating-point.
+*)
+  k := extended(16.0)/extended(105.0);
+  WriteLn( SysUtils.Format( ' (16/105)Sqrt(pi) =  %g', [k*Sqrt(PI)]));
+  WriteLn( SysUtils.Format( 'Gamma(-9/2)       = %g', [Gamma(-4.5)]));
+  k := extended(32.0)/extended(945.0);
+  WriteLn( SysUtils.Format( '-(32/945)Sqrt(pi) = %g', [-k*Sqrt(PI)]));
+end.

Task/Gamma-function/Loglan82/gamma-function.loglan82

@@ -0,0 +1,53 @@
+(* Gamma function *)
+(* Lanczos approximation *)
+
+block
+var
+  x: real;
+
+  unit gamma: function (z: real): real;
+  const
+    pi = 3.14159265358979;
+  var
+    lz: arrayof real;
+
+    unit ln_gamma: function (z: real): real;
+    (* Uses lz and pi *)
+    var
+      i: integer,
+      b, a: real;
+    begin
+      if z < 0.5 then
+        result := ln(pi / sin(pi * z)) - ln_gamma(1.0 - z)
+      else
+        z := z - 1.0;
+        b := z + 5.5;
+        a := lz(0);
+        for i:= 1 to 6
+        do
+          a:= a + lz(i) / (z + i)
+        od;
+        result := (ln(sqrt(2.0 * pi)) + ln(a) - b) + ln(b) * (z + 0.5)
+      fi;
+    end ln_gamma;
+
+  begin
+    array lz dim (0 : 6);
+    lz(0) := 1.00000000019001;
+    lz(1) := 76.1800917294715;
+    lz(2) := -86.5053203294168;
+    lz(3) := 24.0140982408309;
+    lz(4) := -1.23173957245015;
+    lz(5) := 1.2086509738662E-3;
+    lz(6) := -0.000005395239385;
+    result := exp(ln_gamma(z))
+  end gamma;
+
+begin
+  x:= 0.1;
+  while x < 2.05
+  do
+    writeln(x: 4: 1, "  ", gamma(x): 15: 12);
+    x:= x + 0.1
+  od;
+end

Task/Gamma-function/Modula-2/gamma-function.mod2

@@ -0,0 +1,55 @@
+MODULE GammaFun;
+(* Gamma function *)
+(* Lanczos approximation *)
+FROM LongMath IMPORT
+  exp, ln, pi, sin, sqrt;
+FROM SLongIO IMPORT
+  WriteFixed;
+FROM STextIO IMPORT
+  WriteLn, WriteString;
+
+VAR
+  X: LONGREAL;
+
+PROCEDURE Gamma(Z: LONGREAL): LONGREAL;
+TYPE
+  LZArr = ARRAY [0 .. 6] OF LONGREAL;
+VAR
+  LZ: LZArr;
+
+  PROCEDURE LnGamma(Z: LONGREAL): LONGREAL;
+  (* Uses LZ *)
+  VAR
+    B, A: LONGREAL;
+    I: CARDINAL;
+  BEGIN
+    IF Z < 0.5 THEN
+      RETURN ln(pi / sin(pi * Z)) - LnGamma(1.0 - Z)
+    ELSE
+      Z:= Z - 1.0;
+      B:= Z + 5.5;
+      A:= LZ[0];
+      FOR I:= 1 TO 6 DO
+        A:= A + LZ[I] / (Z + LFLOAT(I))
+      END;
+      RETURN (ln(sqrt(2. * pi)) + ln(A) - B) + ln(B) * (Z + 0.5)
+    END;
+  END LnGamma;
+
+BEGIN
+  LZ:= LZArr{1.00000000019001, 76.1800917294715, -86.5053203294168,
+             24.0140982408309, -1.23173957245015, 1.2086509738662E-3,
+             -0.000005395239385};
+  RETURN exp(LnGamma(Z))
+END Gamma;
+
+BEGIN
+  X:= 0.1;
+  WHILE X < 2.05 DO
+    WriteFixed(X, 1, 4);
+    WriteString("  ");
+    WriteFixed(Gamma(X), 12, 15);
+    WriteLn;
+    X:= X + 0.1
+  END;
+END GammaFun.

Task/Gamma-function/PHP/gamma-function.php

@@ -0,0 +1,28 @@
+<?php
+// Gamma function
+
+function ln_gamma($z) {
+  $lz = array(1.00000000019001, 76.1800917294715, -86.5053203294168,
+              24.0140982408309, -1.23173957245015,  0.0012086509738662,
+              -0.000005395239385);
+  if ($z < 0.5)
+    return log(M_PI / sin(M_PI * $z)) - ln_gamma(1.0 - $z);
+  else {
+    $z -= 1.0;
+    $b = $z + 5.5;
+    $a = $lz[0];
+    for ($i = 1; $i <= 6; $i++)
+      $a += $lz[$i] / ($z + $i);
+    return (log(sqrt(2 * M_PI)) + log($a) - $b) + log($b) * ($z + 0.5);
+  }
+}
+
+function gamma($z) {
+  return exp(ln_gamma($z));
+}
+
+for ($x = 0.1; $x <= 2.05; $x += 0.1)
+  echo str_pad(number_format($x, 1, ".", ""), 3, " ", STR_PAD_LEFT)."\t".
+    str_pad(number_format(gamma($x), 12, ".", ""), 15, " ", STR_PAD_LEFT).
+    PHP_EOL;
+?>

Task/Gamma-function/Pascal-P/gamma-function.pas

@@ -0,0 +1,48 @@
+program gammafunction(output);
+(* Gamma function *)
+
+const
+  pi = 3.1415926535897932384626433832795;
+
+var
+  x: real;
+
+  function lngamma(z: real): real;
+  var
+    lz: array[0..6] of real;
+    a, b: real;
+    i: integer;
+  begin
+    lz[0] := 1.00000000019001;
+    lz[1] := 76.1800917294715;
+    lz[2] := -86.5053203294168;
+    lz[3] := 24.0140982408309;
+    lz[4] := -1.23173957245015;
+    lz[5] := 0.0012086509738662;
+    lz[6] := -0.000005395239385;
+    if (z < 0.5) then
+      lngamma := ln(pi / sin(pi * z)) - lngamma(1.0 - z)
+    else
+    begin
+      z := z - 1.0;
+      b := z + 5.5;
+      a := lz[0];
+      for i := 1 to 6 do
+        a := a + lz[i] / (z + i);
+      lngamma := (ln(sqrt(2 * pi)) + ln(a) - b) + ln(b) * (z + 0.5);
+    end;
+  end;
+
+  function gamma(z: real): real;
+  begin
+    gamma := exp(lngamma(z));
+  end;
+
+begin
+  x := 0.1;
+  while x <= 2.05 do
+  begin
+    writeln(x, ' ', gamma(x));
+    x := x + 0.1;
+  end;
+end.

Task/Gamma-function/PowerShell/gamma-function.ps1

@@ -0,0 +1,3 @@
+Add-Type -Path "C:\Program Files (x86)\Math\MathNet.Numerics.3.12.0\lib\net40\MathNet.Numerics.dll"
+
+1..20 | ForEach-Object {[MathNet.Numerics.SpecialFunctions]::Gamma($_ / 10)}

Task/Gamma-function/QuickBASIC/gamma-function.basic

@@ -0,0 +1,35 @@
+' Gamma function
+DECLARE FUNCTION Gamma# (Z#)
+DECLARE FUNCTION LnGamma# (BYVAL Z#)
+FOR X# = .1 TO 2.05 STEP .1
+  PRINT USING "##.#  "; X#;
+  PRINT USING "#.#########"; Gamma#(X#)
+NEXT X#
+END
+
+FUNCTION Gamma# (Z#)
+  Gamma# = EXP(LnGamma#(Z#))
+END FUNCTION
+
+FUNCTION LnGamma# (BYVAL Z#)
+  CONST PI# = 3.14159265358979#
+  DIM LZ#(6)
+  LZ#(0) = 1.00000000019001#
+  LZ#(1) = 76.1800917294715#
+  LZ#(2) = -86.5053203294168#
+  LZ#(3) = 24.0140982408309#
+  LZ#(4) = -1.23173957245015#
+  LZ#(5) = 1.2086509738662D-03
+  LZ#(6) = -.000005395239385#
+  IF Z# < .5 THEN
+    LnGamma# = LOG(PI# / SIN(PI# * Z#)) - LnGamma#(1# - Z#)
+  ELSE
+    Z# = Z# - 1#
+    B# = Z# + 5.5
+    A# = LZ#(0)
+    FOR I% = 1 TO 6
+      A# = A# + LZ#(I%) / (Z# + I%)
+    NEXT I%
+    LnGamma# = (LOG(SQR(2 * PI#)) + LOG(A#) - B#) + LOG(B#) * (Z# + .5)
+  END IF
+END FUNCTION

Task/Gamma-function/VBA/gamma-function.vba

@@ -0,0 +1,35 @@
+' Gamma function
+
+Sub MainGamma()
+  Dim X As Double
+  For X = 0.1 To 2.05 Step 0.1
+    Debug.Print X, FNGamma(X)
+  Next X
+End Sub
+
+Function FNGamma(Z As Double) As Double
+  FNGamma = Exp(FNLnGamma(Z))
+End Function
+
+Function FNLnGamma(ByVal Z As Double) As Double
+  Dim LZ(6) As Double
+  LZ(0) = 1.00000000019001
+  LZ(1) = 76.1800917294715
+  LZ(2) = -86.5053203294168
+  LZ(3) = 24.0140982408309
+  LZ(4) = -1.23173957245015
+  LZ(5) = 1.2086509738662E-03
+  LZ(6) = -0.000005395239385
+  Pi = WorksheetFunction.Pi()
+  If Z < 0.5 Then
+    FNLnGamma = Log(Pi / Sin(Pi * Z)) - FNLnGamma(1# - Z)
+  Else
+    Z = Z - 1#
+    B = Z + 5.5
+    A = LZ(0)
+    For I = 1 To 6
+      A = A + LZ(I) / (Z + I)
+    Next I
+    FNLnGamma = (Log(Sqr(2 * Pi)) + Log(A) - B) + Log(B) * (Z + 0.5)
+  End If
+End Function

Task/Gamma-function/XPL0/gamma-function-1.xpl0

@@ -0,0 +1,50 @@
+function real Gamma (X);
+real X, A, Y, Sum;
+integer N;
+begin
+   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   := X - 1.0;
+   Sum := A (29);
+   for N:= 29-1 downto 0 do
+      Sum := Sum * Y + A (N);
+   return 1.0 / Sum;
+end \Gamma\;
+
+\Test program:
+integer I;
+begin
+   Format(0, 14);
+   for I:= 1 to 10 do
+      [RlOut(0, Gamma (Float (I) / 3.0));  CrLf(0)];
+end

Task/Gamma-function/XPL0/gamma-function-2.xpl0

@@ -0,0 +1,50 @@
+\ Gamma function
+\ Lanczos approximation
+code ChOut=8, Text=12;
+code real RlOut=48, Float=49, Format=52, Sqrt=53, Ln=54, Exp=55, Sin=56;
+real X;
+
+  function real Gamma(Z);
+  real Z;
+  def Pi = 3.14159265358979;
+  real LZ;
+
+    function real LnGamma(Z);
+    \ Uses LZ and Pi;
+    real Z;
+    real B, A;
+    integer I;
+    begin
+    if Z < 0.5 then
+      return Ln(Pi / Sin(Pi * Z)) - LnGamma(1.0 - Z)
+    else
+      begin
+      Z:= Z - 1.0;
+      B:= Z + 5.5;
+      A:= LZ(0);
+      for I:= 1 to 6 do
+        A:= A + LZ(I) / (Z + Float(I));
+      return (Ln(Sqrt(2. * Pi)) + Ln(A) - B) + Ln(B) * (Z + .5)
+      end;
+    end;
+
+  begin
+  LZ:= [1.00000000019001, 76.1800917294715, -86.5053203294168,
+       24.0140982408309, -1.23173957245015, 1.2086509738662e-3,
+       -0.000005395239385];
+  return Exp(LnGamma(Z))
+  end;
+
+begin
+X:= 0.1;
+while X < 2.05 do
+  begin
+  Format(2, 1);
+  RlOut(0, X);
+  Text(0, "  ");
+  Format(2, 12);
+  RlOut(0, Gamma(X));
+  CrLf(0);
+  X:= X + 0.1
+  end;
+end