 {
 ****************************************************************************
 CRW32 project
 Copyright (C) by Kuryakin Alexey, Sarov, Russia, 2001, <kouriakine@mail.ru>
 Elementary mathematical functions.
 Modifications:
 20010728 - Creation (uses CRW16) & test
 20210317 - IsBit,HasFlags
 ****************************************************************************
 }

unit _ef; { elementary functions }

{$I _sysdef}

interface

uses
 math, _fpu, _zm;

 {
 Bit operations.
 }
function GetBitMask(BitNum:Integer):Integer;      // 1 shl BitNum
function IsBit(Data,BitNum:Integer):Boolean;      // Data has this bit number?
function HasFlags(Mode,Flags:Integer):Boolean;    // Mode has bits from Flags?

 {
 Evaluate precision with given absolute and relative threshold
 }
function  Precision(AbsEps,RelEps,Value:Double):Double;

 {
 MaxIntXXX value is max. INTEGER value.
 It means, MaxIntXXX+1.0 is equals MaxIntXXX!
 MaxIntSingle   =                 16.777.216 <-> 24 bit
 MaxIntDouble   =      9.007.199.254.740.992 <-> 53 bit
 MaxComp        =  9.223.372.036.854.775.807
 MaxIntExtended = 18.446.744.073.709.551.600 <-> 64 bit
 }
function MaxIntSingle: Single; register;
function MaxIntDouble: Double; register;
function MaxIntExtended: Extended; register;

 {
 Precision routines
 }

 {
 Fast multiplication to power of two: fscale(X,N) := X * 2 ^ N
 }
function fscale(X:Extended; N:integer): Extended; register;

 {
 Extract exponent and mantissa from X
 Find decomposition X = Mantissa * 2 ^ Exponent, 1<=abs(Mantissa)<2
 }
procedure fxtract(X: Extended; var Mantissa: Extended; var Exponent: Integer); register;

 {
 Compress Argument to keep only NumberOfSignificantBits binary digits of
 significant.
 1. Find decomposition Argument = Significant * 2 ^ Exponent
    where 1 <= abs(Significant) < 2
 2. Evaluate value with given significant bits
    Result := round( Significant * 2 ^ NumberOfSignificantBits) *
            2 ^ ( Exponent - NumberOfSignificantBits )
 }
function fbitcompress(Argument:Extended;
                      NumberOfSignificantBits:integer):Extended; register;
 {
 Compress Argument to keep only 1/ScaleFactor relative tolerrance.
 1. Find decomposition Argument = Significant * 2 ^ Exponent
    where 1 <= abs(Significant) < 2
 2. Evaluate value with given relative significant tolerrance
    Result := round( Significant * ScaleFactor) / ScaleFactor *
              2 ^ Exponent
 }
function frelcompress(Argument,ScaleFactor:Extended):Extended; register;

 {
 Compress Argument to keep only 1/ScaleFactor absolute tolerrance.
 Result := round( Significant * ScaleFactor) / ScaleFactor
 }
function fabscompress(Argument,ScaleFactor:Extended):Extended; register;

 {
 if x<0, Sgn(x)=-1, else Sgn(x)=1
 }
function Sgn(x:Extended): Integer; overload; register;
function Sgn(x:Double): Integer;   overload; register;
function Sgn(x:Single): Integer;   overload; register;
function Sgn(x:Int64): Integer;    overload; register;
function Sgn(x:Integer): Integer;  overload; register;

 {
 if x<0, Sign(x)=-1, if x>0, Sign(x)=1, Sign(0)=0
 }
function Sign(x:Extended): Integer; overload; register;
function Sign(x:Double): Integer;   overload; register;
function Sign(x:Single): Integer;   overload; register;
function Sign(x:Int64): Integer;    overload; register;
function Sign(x:Integer): Integer;  overload; register;

 {
 if x=0, Kronek=1, else Kronek=0
 }
function Kronek(x:Extended): Integer; overload; register;
function Kronek(x:Double): Integer;   overload; register;
function Kronek(x:Single): Integer;   overload; register;
function Kronek(x:Int64): Integer;    overload; register;
function Kronek(x:Integer): Integer;  overload; register;

 {
 find scalar production of two vectors
 }
function ScalarProduct(const x,y:array of Extended; N:Integer):Extended; overload; register;
function ScalarProduct(const x,y:array of Double; N:Integer):Extended;   overload; register;
function ScalarProduct(const x,y:array of Single; N:Integer):Extended;   overload; register;
function ScalarProduct(const x,y:array of Int64; N:Integer):Extended;    overload; register;
function ScalarProduct(const x,y:array of Integer; N:Integer):Extended;  overload; register;

 {
 find cumulative sum of vector
 }
function CumulativeSum(const x:array of Extended; N:Integer):Extended; overload; register;
function CumulativeSum(const x:array of Double; N:Integer):Extended;   overload; register;
function CumulativeSum(const x:array of Single; N:Integer):Extended;   overload; register;
function CumulativeSum(const x:array of Int64; N:Integer):Extended;    overload; register;
function CumulativeSum(const x:array of Integer; N:Integer):Extended;  overload; register;

 {
 find index of maximal element in array x[0..N-1]
 }
function IndexOfMax(const x:array of Extended; N:Integer):Integer; overload; register;
function IndexOfMax(const x:array of Double; N:Integer):Integer;   overload; register;
function IndexOfMax(const x:array of Single; N:Integer):Integer;   overload; register;
function IndexOfMax(const x:array of Int64; N:Integer):Integer;    overload; register;
function IndexOfMax(const x:array of Integer; N:Integer):Integer;  overload; register;

 {
 find index of minimal element in array x[0..N-1]
 }
function IndexOfMin(const x:array of Extended; N:Integer):Integer; overload; register;
function IndexOfMin(const x:array of Double; N:Integer):Integer;   overload; register;
function IndexOfMin(const x:array of Single; N:Integer):Integer;   overload; register;
function IndexOfMin(const x:array of Int64; N:Integer):Integer;    overload; register;
function IndexOfMin(const x:array of Integer; N:Integer):Integer;  overload; register;

 {
 find value of maximal element in array x[0..N-1]
 }
function ValueOfMax(const x:array of Extended; N:Integer):Extended; overload; register;
function ValueOfMax(const x:array of Double; N:Integer):Double;     overload; register;
function ValueOfMax(const x:array of Single; N:Integer):Single;     overload; register;
function ValueOfMax(const x:array of Int64; N:Integer):Int64;       overload; register;
function ValueOfMax(const x:array of Integer; N:Integer):Integer;   overload; register;

 {
 find value of minimal element in array x[0..N-1]
 }
function ValueOfMin(const x:array of Extended; N:Integer):Extended; overload; register;
function ValueOfMin(const x:array of Double; N:Integer):Double;     overload; register;
function ValueOfMin(const x:array of Single; N:Integer):Single;     overload; register;
function ValueOfMin(const x:array of Int64; N:Integer):Int64;       overload; register;
function ValueOfMin(const x:array of Integer; N:Integer):Integer;   overload; register;

 {
 Y = GAMMA(X) evaluates the gamma function at X.
 gamma(x) = integral from 0 to inf of t^(x-1) exp(-t) dt.
 gamma(n+1) = n! = n factorial = prod(1:n).
 Computation is based on an algorithm outlined in W. J. Cody,
 'An Overview of Software Development for Special Functions',
 Lecture Notes in Mathematics, 506, Numerical Analysis Dundee,
 1975, G. A. Watson (ed.), Springer Verlag, Berlin, 1976.
 }
function Gamma(x:Extended):Extended;
function GammaLn(x:Extended):Extended;

 {
 Incomplete Gamma function.
 gammainc(x,a) = 1/gamma(a) * integral from 0 to x of t^(a-1)*exp(-t) dt
 Note that gammainc(x,a) approaches 1 as x approaches infinity.
 (if x>=1E30,gammainc returns 1)
 Matlab 3.5, C.R. Denham 6-9-88, Copyright (c) 1988 by the MathWorks, Inc.
 }
function GammaInc(x,a:Extended):Extended;

 {
 Gamma density, cumulative and inversed distribution function.
 Some references refer to the gamma distribution with a single parameter.
 This corresponds to the default of B = 1.
 GAMMAINC does computational work.
 Matlab 5.0
 }
function GammaDistr(x,a,b:Extended):Extended;
function GammaCumDistr(x,a,b:Extended):Extended;
function GammaCumDistrInv(p,a,b:Extended):Extended;

 {
 Chi-square density, cumulative and inversed distribution function.
 P = CHI2CumDistr(X,V) returns the chi-square cumulative distribution
 function with V degrees of freedom at the values in X.
 The chi-square density function with V degrees of freedom,
 is the same as a gamma density function with parameters V/2 and 2.
 Matlab 5.0
 }
function Chi2Distr(x,v:Extended):Extended;
function Chi2CumDistr(x,v:Extended):Extended;
function Chi2CumDistrInv(p,v:Extended):Extended;

 {
 Miscellaneous routines
 }
function Trapezium(x1,y1,x2,y2:double):double;
function Sinc(x:Double):Double;
function BesselN(N:integer; X:Double; Modify:boolean=false ):Double;
function Phase( Re,Im:Double ):Double;
function DeciBell(Re,Im,ZeroLabel,Range:Double):Double;
function GoldenRatio:Double;

implementation

function GetBitMask(BitNum:Integer):Integer;
begin
 Result:=Integer(1) shl BitNum;
end;

function IsBit(Data,BitNum:Integer):Boolean;
begin
 Result:=((Data and (Integer(1) shl BitNum))<>0);
end;

function HasFlags(Mode,Flags:Integer):Boolean;
begin
 Result:=((Mode and Flags)<>0);
end;

function Precision(AbsEps,RelEps,Value:Double):Double;
var A,R:Double;
begin
 A:=abs(AbsEps);
 R:=abs(RelEps)*abs(Value);
 if A>R then Result:=A else Result:=R;
end;

function MaxIntSingle: Single;
begin
 Result:=fscale(1.0,24);
end;

function MaxIntDouble: Double;
begin
 Result:=fscale(1.0,53);
end;

function MaxIntExtended: Extended;
begin
 Result:=fscale(1.0,64);
end;

 { fscale(X,N) := X * 2 ^ N }
function fscale(X:Extended; N:integer):Extended;
asm
 PUSH    EAX               { push N }
 FILD    dword ptr [ESP]   { st(0)=N }
 POP     EAX               { pop N }
 FLD     X                 { st(1)=N, st(0)=X }
 FSCALE                    { st(1)=N, st(0)=X*2^N }
 FSTP    ST(1)             { st(0)=X*2^N }
 FWAIT                     { wait FPU }
end;

 {
 Extract exponent and mantissa from X
 Mantissa ptr in EAX, Exponent ptr in EDX
 }
procedure fxtract(X: Extended; var Mantissa: Extended; var Exponent: Integer);
asm
 FLD X                         { st(0)=X }
 PUSH    EAX                   { push Exponent ptr }
 MOV     dword ptr [edx], 0    { Exponent=0 }
 FTST                          { test X }
 FSTSW   AX                    { store FPU status to AX }
 FWAIT                         { wait FPU }
 SAHF                          { store AX to CPU flags }
 JZ      @@Done                { jump if X=0 }
 FXTRACT                       { st(1)=Exponent, st(0)=Mantissa }
 FXCH    ST(1)                 { st(1)=Mantissa, st(0)=Exponent }
 FISTP   dword ptr [edx]       { pop and store st(0) to Exponent }
@@Done:                        { now st(0)=Mantissa }
 POP     EAX                   { pop Exponent ptr back to eax }
 FSTP    tbyte ptr [eax]       { pop and store st(0) to Mantissa }
 FWAIT                         { wait FPU }
end;

 {
 compress value to given number of significant bits
 if Argument=mantissa*2^exp, 1<=abs(mantissa)<2, then
 result=trunc(mantissa*2^NumberOfSignificantBits)*2^(exp-NumberOfSignificantBits)
 }
function fbitcompress(Argument:Extended;
                      NumberOfSignificantBits:integer):Extended;
asm
 FLD     Argument         { st(0)=Argument=mantissa*2^exp }
 FXTRACT                  { st(1)=exp, st(0)=mantissa }
 PUSH    EAX              { push NumberOfSignificantBits }
 FILD    dword ptr [ESP]  { st(2)=exp, st(1)=mantissa, st(0)=NumberOfSignificantBits }
 POP     EAX              { pop  NumberOfSignificantBits }
 FXCH    ST(1)            { st(2)=exp, st(1)=NumberOfSignificantBits, st(0)=mantissa }
 FSCALE                   { st(2)=exp, st(1)=NumberOfSignificantBits, st(0)=mantissa*2^NumberOfSignificantBits }
 FRNDINT                  { st(2)=exp, st(1)=NumberOfSignificantBits, st(0)=trunc(mantissa*2^NumberOfSignificantBits) }
 FXCH    ST(1)            { st(2)=exp, st(1)=trunc(mantissa*2^NumberOfSignificantBits), st(0)=NumberOfSignificantBits }
 FSUBR   ST(0),ST(2)      { st(2)=exp, st(1)=trunc(mantissa*2^NumberOfSignificantBits), st(0)=exp-NumberOfSignificantBits }
 FXCH    ST(1)            { st(2)=exp, st(1)=exp-NumberOfSignificantBits, st(0)=trunc(mantissa*2^NumberOfSignificantBits) }
 FSCALE                   { st(0)=trunc(mantissa*2^NumberOfSignificantBits)*2^(exp-NumberOfSignificantBits) }
 FSTP    ST(1)            { delete temporary st(1)=exp-NumberOfSignificantBits }
 FSTP    ST(1)            { delete temporary st(1)=exp }
 FWAIT                    { wait FPU }
end;


 {
 compress value to given relative tolerance
 if Argument=mantissa*2^exp, 1<=abs(mantissa)<2, then
 result=trunc(mantissa*ScaleFactor)/ScaleFactor*2^exp
 }
function frelcompress(Argument,ScaleFactor:Extended):Extended;
asm
 FLD     Argument     { st(0)=Argument=mantissa*2^exp }
 FXTRACT              { st(1)=exp, st(0)=mantissa }
 FLD     ScaleFactor  { st(2)=exp, st(1)=mantissa, st(0)=ScaleFactor }
 FMUL                 { st(1)=exp, st(0)=mantissa*ScaleFactor }
 FRNDINT              { st(1)=exp, st(0)=trunc(mantissa*ScaleFactor) }
 FLD     ScaleFactor  { st(2)=exp, st(1)=trunc(mantissa*ScaleFactor), st(0)=ScaleFactor }
 FDIV                 { st(1)=exp, st(0)=trunc(mantissa*ScaleFactor)/ScaleFactor }
 FSCALE               { st(1)=exp, st(0)=trunc(mantissa*ScaleFactor)/ScaleFactor*2^exp }
 FSTP    ST(1)        { st(0)=trunc(mantissa*ScaleFactor)/ScaleFactor*2^exp }
 FWAIT                { wait FPU }
end;

 {
 compress value to given absolute tolerance
 result=trunc(Argument*ScaleFactor)/ScaleFactor
 }
function fabscompress(Argument,ScaleFactor:Extended):Extended;
asm
 FLD     Argument     { st(0)=Argument }
 FLD     ScaleFactor  { st(1)=Argument, st(0)=ScaleFactor }
 FMUL                 { st(0)=Argument*ScaleFactor }
 FRNDINT              { st(0)=trunc(Argument*ScaleFactor) }
 FLD     ScaleFactor  { st(1)=trunc(Argument*ScaleFactor), st(0)=ScaleFactor }
 FDIV                 { st(0)=trunc(Argument*ScaleFactor)/ScaleFactor }
 FWAIT                { wait FPU }
end;

function Sgn(x:Extended): Integer;
begin
 if x<0 then Result:=-1 else Result:=1;
end;
function Sgn(x:Double): Integer;
begin
 if x<0 then Result:=-1 else Result:=1;
end;
function Sgn(x:Single): Integer;
begin
 if x<0 then Result:=-1 else Result:=1;
end;
function Sgn(x:Int64): Integer;
begin
 if x<0 then Result:=-1 else Result:=1;
end;
function Sgn(x:Integer): Integer;
begin
 if x<0 then Result:=-1 else Result:=1;
end;

function Sign(x:Extended): Integer;
begin
 if x>0 then Result:=1 else if x<0 then Result:=-1 else Result:=0
end;
function Sign(x:Double): Integer;
begin
 if x>0 then Result:=1 else if x<0 then Result:=-1 else Result:=0
end;
function Sign(x:Single): Integer;
begin
 if x>0 then Result:=1 else if x<0 then Result:=-1 else Result:=0
end;
function Sign(x:Int64): Integer;
begin
 if x>0 then Result:=1 else if x<0 then Result:=-1 else Result:=0
end;
function Sign(x:Integer): Integer;
begin
 if x>0 then Result:=1 else if x<0 then Result:=-1 else Result:=0
end;

function Kronek(x:Extended): Integer;
begin
 if x=0 then Result:=1 else Result:=0;
end;
function Kronek(x:Double): Integer;
begin
 if x=0 then Result:=1 else Result:=0;
end;
function Kronek(x:Single): Integer;
begin
 if x=0 then Result:=1 else Result:=0;
end;
function Kronek(x:Int64): Integer;
begin
 if x=0 then Result:=1 else Result:=0;
end;
function Kronek(x:Integer): Integer;
begin
 if x=0 then Result:=1 else Result:=0;
end;

function ScalarProduct(const x,y:array of Extended; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if (@x<>nil) and (@y<>nil) then for i:=0 to N-1 do Result:=Result+x[i]*y[i];
end;
function ScalarProduct(const x,y:array of Double; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if (@x<>nil) and (@y<>nil) then for i:=0 to N-1 do Result:=Result+x[i]*y[i];
end;
function ScalarProduct(const x,y:array of Single; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if (@x<>nil) and (@y<>nil) then for i:=0 to N-1 do Result:=Result+x[i]*y[i];
end;
function ScalarProduct(const x,y:array of Int64; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if (@x<>nil) and (@y<>nil) then for i:=0 to N-1 do Result:=Result+x[i]*y[i];
end;
function ScalarProduct(const x,y:array of Integer; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if (@x<>nil) and (@y<>nil) then for i:=0 to N-1 do Result:=Result+x[i]*y[i];
end;

function CumulativeSum(const x:array of Extended; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=0 to N-1 do Result:=Result+x[i];
end;
function CumulativeSum(const x:array of Double; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=0 to N-1 do Result:=Result+x[i];
end;
function CumulativeSum(const x:array of Single; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=0 to N-1 do Result:=Result+x[i];
end;
function CumulativeSum(const x:array of Int64; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=0 to N-1 do Result:=Result+x[i];
end;
function CumulativeSum(const x:array of Integer; N:Integer):Extended;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=0 to N-1 do Result:=Result+x[i];
end;

function IndexOfMax(const x:array of Extended; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]>x[Result] then Result:=i;
end;
function IndexOfMax(const x:array of Double; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]>x[Result] then Result:=i;
end;
function IndexOfMax(const x:array of Single; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]>x[Result] then Result:=i;
end;
function IndexOfMax(const x:array of Int64; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]>x[Result] then Result:=i;
end;
function IndexOfMax(const x:array of Integer; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]>x[Result] then Result:=i;
end;

function IndexOfMin(const x:array of Extended; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]<x[Result] then Result:=i;
end;
function IndexOfMin(const x:array of Double; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]<x[Result] then Result:=i;
end;
function IndexOfMin(const x:array of Single; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]<x[Result] then Result:=i;
end;
function IndexOfMin(const x:array of Int64; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]<x[Result] then Result:=i;
end;
function IndexOfMin(const x:array of Integer; N:Integer):Integer;
var i:Integer;
begin
 Result:=0;
 if @x<>nil then for i:=1 to N-1 do if x[i]<x[Result] then Result:=i;
end;

function ValueOfMax(const x:array of Extended; N:Integer):Extended;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]>Result then Result:=x[i];
 end else Result:=0;
end;
function ValueOfMax(const x:array of Double; N:Integer):Double;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]>Result then Result:=x[i];
 end else Result:=0;
end;
function ValueOfMax(const x:array of Single; N:Integer):Single;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]>Result then Result:=x[i];
 end else Result:=0;
end;
function ValueOfMax(const x:array of Int64; N:Integer):Int64;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]>Result then Result:=x[i];
 end else Result:=0;
end;
function ValueOfMax(const x:array of Integer; N:Integer):Integer;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]>Result then Result:=x[i];
 end else Result:=0;
end;

function ValueOfMin(const x:array of Extended; N:Integer):Extended;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]<Result then Result:=x[i];
 end else Result:=0;
end;
function ValueOfMin(const x:array of Double; N:Integer):Double;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]<Result then Result:=x[i];
 end else Result:=0;
end;
function ValueOfMin(const x:array of Single; N:Integer):Single;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]<Result then Result:=x[i];
 end else Result:=0;
end;
function ValueOfMin(const x:array of Int64; N:Integer):Int64;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]<Result then Result:=x[i];
 end else Result:=0;
end;
function ValueOfMin(const x:array of Integer; N:Integer):Integer;
var i:Integer;
begin
 if (N>0) and (@x<>nil) then begin
  Result:=x[0];
  for i:=1 to N-1 do if x[i]<Result then Result:=x[i];
 end else Result:=0;
end;

function Gamma(x:Extended):Extended;
const
 xbig = 171.4584;
 p:array[1..8] of extended =
 (-1.71618513886549492533811e+0,
   2.47656508055759199108314e+1,
  -3.79804256470945635097577e+2,
   6.29331155312818442661052e+2,
   8.66966202790413211295064e+2,
  -3.14512729688483675254357e+4,
  -3.61444134186911729807069e+4,
   6.64561438202405440627855e+4);
 q:array[1..8] of extended =
 (-3.08402300119738975254353e+1,
   3.15350626979604161529144e+2,
  -1.01515636749021914166146e+3,
  -3.10777167157231109440444e+3,
   2.25381184209801510330112e+4,
   4.75584627752788110767815e+3,
  -1.34659959864969306392456e+5,
  -1.15132259675553483497211e+5);
 c :array[1..7] of extended=
 (-1.910444077728e-03,
   8.4171387781295e-04,
  -5.952379913043012e-04,
   7.93650793500350248e-04,
  -2.777777777777681622553e-03,
   8.333333333333333331554247e-02,
   5.7083835261e-03);
var
 res,sign,fact,y,y1,ysq,gam,z,xnum,xden,sum:extended;
 i,n:integer;
begin
 sign:=1.0;
 fact:=1.0;
 y:=x;
 {Negative x}
 if y<=0.0 then begin
  y:=-x;
  if trunc(y) mod 2 <> 0 then sign:=-1.0;
  res:=frac(y);
  if res<>0.0 then fact:=-pi/sin(pi*res) else begin
   Result:=_nan;
   exit;
  end;
  y:=y+1.0;
 end;
 {Small x}
 if y<MachEps then begin
  gam:=1.0/y;
 { macheps < x <= 12 }
 end else
 if y<=12.0 then begin
  y1:=y;
  if y<1 then begin
   n:=0;
   z:=y;
   y:=y+1.0;
  end else begin
   n:=trunc(y)-1;
   y:=y-n;
   z:=y-1.0;
  end;
  { Rational approximation for 1.0 < x < 2.0 }
  xnum:=0.0;
  xden:=1.0;
  for i:=1 to 8 do begin
   xnum:=(xnum+p[i])*z;
   xden:=xden*z+q[i];
  end;
  gam:=xnum/xden+1;
  if y>y1 then begin            {Adjust result for 0.0 < x < 1.0}
   gam:=gam/y1;
  end else
  if y<y1 then begin            {Adjust result for 2.0 < x < 12.0}
   for i:=1 to n do begin
    gam:=gam*y;
    y:=y+1.0;
   end;
  end;
 end else
 { Different rational approximation for 12 < x < xbig}
 if y<=xbig then begin
  ysq:=y*y;
  sum:=c[7];
  for i:=1 to 6 do sum:=sum/ysq+c[i];
  sum:=sum/y-y+0.9189385332046727417803297+(y-0.5)*ln(y);
  gam:=exp(sum);
 end else begin { Large x }
  Result:=_PlusInf;
  exit;
 end;
 { Final adjustments }
 gam:=sign*gam;
 if fact<>1.0 then gam:=fact/gam;
 if x=int(x) then gam:=int(gam);
 Result:=gam;
end;

function GammaLn(x:Extended):Extended;
const
 xbig = 171.4584;
 c :array[1..7] of extended =
 (-1.910444077728e-03,
   8.4171387781295e-04,
  -5.952379913043012e-04,
   7.93650793500350248e-04,
  -2.777777777777681622553e-03,
   8.333333333333333331554247e-02,
   5.7083835261e-03);
var
 ysq,sum:extended;
 i:integer;
begin
 if x<xbig then Result:=Ln(Gamma(x)) else begin
  ysq:=x*x;
  sum:=c[7];
  for i:=1 to 6 do sum:=sum/ysq+c[i];
  sum:=sum/x-x+0.9189385332046727417803297+(x-0.5)*ln(x);
  Result:=sum;
 end;
end;

function GammaInc(x,a:Extended):Extended;
const
 itmax = 100;
var n:integer; g,epss,b,gln,ap,sum,del,gold,a0,a1,b0,b1,fac,ana,anf:Extended;
begin
 {epss:=3.0e-7;}   {From "Numerical Recipes".}
 epss:=MachEps;
 gln:=GammaLn(a);
 if x <= 0.0 then b:=0.0 else
 if x >= 1.0E30 then b:=1.0 else
 if x < a+1.0 then begin
  ap:=a;   { Series expansion method. }
  sum:=1.0/a;
  del:=sum;
  for n:=1 to itmax do begin
   ap:=ap+1.0;
   del:=del*x/ap;
   sum:=sum+del;
   if abs(del) < abs(sum)*epss then break;
  end;
  b:=sum*exp(-x+a*ln(x)-gln);
 end else begin
  gold:=0.0;   { Continued-fraction method. }
  a0:=1.0;
  a1:=x;
  b0:=0.0;
  b1:=1.0;
  fac:=1.0;
  for n:=1 to itmax do begin
   ana:=n-a;
   a0:=(a1+a0*ana)*fac;
   b0:=(b1+b0*ana)*fac;
   anf:=n*fac;
   a1:=x*a0+anf*a1;
   b1:=x*b0+anf*b1;
   if anf <> 0.0 then fac:=1.0/a1;
   g:=b1*fac;
   if abs(g-gold)/g < epss then break;
  end;
  b:=1.0-exp(-x+a*ln(x)-gln)*g;
 end;
 Result:=b;
end;

function GammaDistr(x,a,b:Extended):Extended;
begin
 Result:=exp((a-1.0)*ln(x)-(x/b)-(GammaLn(a)-a*ln(b)));
end;

function GammaCumDistr(x,a,b:Extended):Extended;
begin
 Result:=GammaInc(x/b,a);
end;

type
 TGammaRec=record a,b,p:Extended; end;

function GCD(x:double; Custom:Pointer):double;
begin
 with TGammaRec(Custom^) do Result:=GammaCumDistr(x,a,b)-p;
end;

function GammaCumDistrInv(p,a,b:Extended):Extended;
var x1,x2:Extended; GammaRec:TGammaRec;
begin
 Result:=0.0;
 if (p<=0.0) or (p>1.0) then exit;
 GammaRec.a:=a;
 GammaRec.b:=b;
 GammaRec.p:=p;
 x1:=0.0;
 x2:=1.0;
 while x2<1.0E30 do begin
  if GammaCumDistr(x2,a,b)>p then begin
   Result:=FindZero(GCD,x1,x2,MachEps,@GammaRec);
   break;
  end;
  x1:=x2;
  x2:=x2*2.0;
 end;
end;

 {
 Chi-square density,cumulative and inversed distribution function.
 P = CHI2CumDistr(X,V) returns the chi-square cumulative distribution
    function with V degrees of freedom at the values in X.
    The chi-square density function with V degrees of freedom,
    is the same as a gamma density function with parameters V/2 and 2.
 Matlab 5.0
 }
function Chi2Distr(x,v:Extended):Extended;
begin
 Result:=GammaDistr(x,v/2.0,2.0);
end;

function Chi2CumDistr(x,v:Extended):Extended;
begin
 Result:=GammaCumDistr(x,v/2.0,2.0);
end;

function Chi2CumDistrInv(p,v:Extended):Extended;
begin
 Result:=GammaCumDistrInv(p,v/2.0,2.0);
end;

function Trapezium(x1,y1,x2,y2:double):double;
begin
 Result:=0.5*(y1+y2)*(x2-x1);
end;

function Sinc(x:Double):Double;
begin
 if abs(x)<MachEps then Result:=1.0 else Result:=sin(x)/x;
end;

function BesselN(N:integer; X:Double; Modify:boolean=false ):Double;
var k:integer; y,y2,s,c,NearlyZero:Double;
begin
 NearlyZero:=MachEps*2.0;
 s:=0.0;
 c:=1.0;
 y:=X/2.0;
 y2:=sqr(y);
 for k:=1 to N do c:=c*y/k;
 k:=1;
 while abs(c) > NearlyZero do begin
  s:=s+c;
  c:=(c*y2/k)/(N+k);
  if not Modify then c:=-c;
  k:=k+1;
 end;
 Result:=s;
end;

function Phase( Re,Im:Double ):Double;
begin
 if Abs(Re)<1.0E-8 then Result:=sign(Im)*pi/2.0 else Result:=ArcTan2(Im,Re);
end;

function DeciBell(Re,Im,ZeroLabel,Range:Double):Double;
begin
 DeciBell:=20.0*Log10(max(Hypot(Re,Im),ZeroLabel/Range)/ZeroLabel);
end;

function GoldenRatio:Double;
const Ratio=1.61803398874989484820; // https://mathworld.wolfram.com/GoldenRatio.html
begin
 Result:=Ratio; Exit;
 Result:=(1.0+sqrt(5.0))/2.0;
end;

initialization

finalization

end.

