////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit containts Elementary mathematical functions.                     //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20010728 - Creation (uses CRW16) & test                                    //
// 20210317 - IsBit,HasFlags                                                  //
// 20230506 - Modified for FPC (A.K.)                                         //
// 20250216 - BoolToInt                                                       //
// 20251209 - BytesToKb                                                       //
// 20260213 - ScaleValMulDiv                                                  //
// 20260408 - CalcNumberOfBits                                                //
////////////////////////////////////////////////////////////////////////////////

unit _crw_ef; // Elementary Functions.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface
 
uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, math,
 _crw_alloc, _crw_fpu, _crw_zm;

 {
 Boolean to integer conversion.
 }
function BoolToInt(Cond:Boolean):LongInt; inline;

 {
 Bit operations.
 }

 {
 Bit mask = 1 shl BitNum
 }
function GetBitMask(BitNum:Integer):Int64; inline;

 {
 Calculate number of non-zero bits of argument X.
 }
function CalcNumberOfBits(X:LongInt):Integer; overload;
function CalcNumberOfBits(X:Int64):Integer;overload;

 {
 Data has given bit number (BitNum)?
 }
function IsBit(Data:LongInt;  BitNum:Integer):Boolean; overload; inline;
function IsBit(Data:LongWord; BitNum:Integer):Boolean; overload; inline;
function IsBit(Data:Int64;    BitNum:Integer):Boolean; overload; inline;
function IsBit(Data:QWord;    BitNum:Integer):Boolean; overload; inline;

 {
 Mode has bits from Flags?
 }
function HasFlags(Mode,Flags:LongInt):Boolean;  overload; inline;
function HasFlags(Mode,Flags:LongWord):Boolean; overload; inline;
function HasFlags(Mode,Flags:Int64):Boolean; overload; inline;
function HasFlags(Mode,Flags:QWord):Boolean; overload; inline;

 {
 Lift Flags of Mode Up/Down, i.e. set/clear bits of Flags in Mode.
 }
procedure LiftFlags(var Mode:LongInt; Flags:LongInt; Up:Boolean=true);   overload; inline;
procedure LiftFlags(var Mode:LongWord; Flags:LongWord; Up:Boolean=true); overload; inline;
procedure LiftFlags(var Mode:Int64; Flags:Int64; Up:Boolean=true); overload; inline;
procedure LiftFlags(var Mode:QWord; Flags:QWord; Up:Boolean=true); overload; inline;

 {
 Convert Bytes to Kb,Mb,Gb and back.
 }
function BytesToKb(Num:SizeInt):SizeInt; inline;
function KbToBytes(Num:SizeInt):SizeInt; inline;
function BytesToMb(Num:SizeInt):SizeInt; inline;
function MbToBytes(Num:SizeInt):SizeInt; inline;
function BytesToGb(Num:SizeInt):SizeInt; inline;
function GbToBytes(Num:SizeInt):SizeInt; inline;

 {
 Scale value (v): multiply by m, then divide by d.
 }
function ScaleValMulDiv(v:Double; m:Double; d:Double=1.0):Double; overload;
function ScaleValMulDiv(v:Int64; m:Integer; d:Integer=1):Integer; overload;

 {
 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;
function MaxIntDouble: Double;
function MaxIntExtended: Extended;

 {
 Power: base^exponent.
 Handle special case: assume 1^y = x^0 = 1.0 for any x,y.
 }
function power(base,exponent:float):float;

 {
 Integer Power: base^exponent.
 Handle special case: assume 1^y = x^0 = 1.0 for any x,y.
 }
function intpower(base:float; const exponent:Integer):float;

 {
 Precision routines
 }

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

 {
 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);

 {
 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 := int( Significant * 2 ^ NumberOfSignificantBits) *
            2 ^ ( Exponent - NumberOfSignificantBits )
 }
function fbitcompress(Argument:Extended; NumberOfSignificantBits:integer):Extended;

 {
 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 := int( Significant * ScaleFactor) / ScaleFactor *
              2 ^ Exponent
 }
function frelcompress(Argument,ScaleFactor:Extended):Extended;

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

 {
 if x<0, Sgn(x)=-1, else Sgn(x)=1
 }
{$IF SizeOf(Extended)<>SizeOf(Double)}
function Sgn(x:Extended): Integer; overload;
{$ENDIF}
function Sgn(x:Double): Integer;   overload;
function Sgn(x:Single): Integer;   overload;
function Sgn(x:Int64): Integer;    overload;
function Sgn(x:Integer): Integer;  overload;

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

 {
 if x=0, Kronek=1, else Kronek=0
 }
{$IF SizeOf(Extended)<>SizeOf(Double)}
function Kronek(x:Extended): Integer; overload;
{$ENDIF}
function Kronek(x:Double): Integer;   overload;
function Kronek(x:Single): Integer;   overload;
function Kronek(x:Int64): Integer;    overload;
function Kronek(x:Integer): Integer;  overload;

 {
 find scalar production of two vectors
 }
{$IF SizeOf(Extended)<>SizeOf(Double)}
function ScalarProduct(const x,y:array of Extended; N:Integer):Extended; overload;
{$ENDIF}
function ScalarProduct(const x,y:array of Double; N:Integer):Extended;   overload;
function ScalarProduct(const x,y:array of Single; N:Integer):Extended;   overload;
function ScalarProduct(const x,y:array of Int64; N:Integer):Extended;    overload;
function ScalarProduct(const x,y:array of Integer; N:Integer):Extended;  overload;

 {
 find cumulative sum of vector
 }
{$IF SizeOf(Extended)<>SizeOf(Double)}
function CumulativeSum(const x:array of Extended; N:Integer):Extended; overload;
{$ENDIF}
function CumulativeSum(const x:array of Double; N:Integer):Extended;   overload;
function CumulativeSum(const x:array of Single; N:Integer):Extended;   overload;
function CumulativeSum(const x:array of Int64; N:Integer):Extended;    overload;
function CumulativeSum(const x:array of Integer; N:Integer):Extended;  overload;

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

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

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

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

 {
 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 BoolToInt(Cond:Boolean):LongInt;
begin
 if Cond
 then Result:=1
 else Result:=0;
end;

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

function CalcNumberOfBits(X:LongInt):Integer;
begin
 Result:=0;
 while (X<>0) do begin
  if ((X and 1)<>0)
  then Inc(Result);
  X:=(X shr 1);
 end;
end;

function CalcNumberOfBits(X:Int64):Integer;
begin
 Result:=0;
 while (X<>0) do begin
  if ((X and 1)<>0)
  then Inc(Result);
  X:=(X shr 1);
 end;
end;

function IsBit(Data:LongInt; BitNum:Integer):Boolean;
begin
 Result:=(((Data shr BitNum) and 1)<>0);
end;
function IsBit(Data:LongWord; BitNum:Integer):Boolean;
begin
 Result:=(((Data shr BitNum) and 1)<>0);
end;
function IsBit(Data:Int64; BitNum:Integer):Boolean;
begin
 Result:=(((Data shr BitNum) and 1)<>0);
end;
function IsBit(Data:QWord; BitNum:Integer):Boolean;
begin
 Result:=(((Data shr BitNum) and 1)<>0);
end;

function HasFlags(Mode,Flags:LongInt):Boolean;
begin
 Result:=((Mode and Flags)<>0);
end;
function HasFlags(Mode,Flags:LongWord):Boolean;
begin
 Result:=((Mode and Flags)<>0);
end;
function HasFlags(Mode,Flags:Int64):Boolean;
begin
 Result:=((Mode and Flags)<>0);
end;
function HasFlags(Mode,Flags:QWord):Boolean;
begin
 Result:=((Mode and Flags)<>0);
end;

procedure LiftFlags(var Mode:LongInt; Flags:LongInt; Up:Boolean=true);
begin
 if Up then Mode:=Mode or Flags else Mode:=Mode and not Flags;
end;
procedure LiftFlags(var Mode:LongWord; Flags:LongWord; Up:Boolean=true);
begin
 if Up then Mode:=Mode or Flags else Mode:=Mode and not Flags;
end;
procedure LiftFlags(var Mode:Int64; Flags:Int64; Up:Boolean=true);
begin
 if Up then Mode:=Mode or Flags else Mode:=Mode and not Flags;
end;
procedure LiftFlags(var Mode:QWord; Flags:QWord; Up:Boolean=true);
begin
 if Up then Mode:=Mode or Flags else Mode:=Mode and not Flags;
end;

function BytesToKb(Num:SizeInt):SizeInt; begin Result:=(Num shr 10); end;
function KbToBytes(Num:SizeInt):SizeInt; begin Result:=(Num shl 10); end;
function BytesToMb(Num:SizeInt):SizeInt; begin Result:=(Num shr 20); end;
function MbToBytes(Num:SizeInt):SizeInt; begin Result:=(Num shl 20); end;
function BytesToGb(Num:SizeInt):SizeInt; begin Result:=(Num shr 30); end;
function GbToBytes(Num:SizeInt):SizeInt; begin Result:=(Num shl 30); end;

function ScaleValMulDiv(v:Double; m:Double; d:Double=1.0):Double;
begin
 Result:=v;
 if (m<>1.0) then Result:=Result*m;
 if (d<>1.0) and (d<>0.0) then Result:=Result/d;
end;

function ScaleValMulDiv(v:Int64; m:Integer; d:Integer=1):Integer;
begin
 Result:=v;
 if (m<>1) then Result:=Result*m;
 if (d<>1) and (d<>0) then Result:=Result div d;
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;

function power(base,exponent:float):float;
begin
 // Handle special case: always 1^y = x^0 = 1
 if (base=1.0) or (exponent=0.0) then Exit(1.0);
 Result:=Math.Power(base,exponent);
end;

function intpower(base:float; const exponent:Integer):float;
begin
 // Handle special case: always 1^y = x^0 = 1
 if (base=1.0) or (exponent=0) then Exit(1.0);
 Result:=Math.IntPower(base,exponent);
end;

 { fscale(X,N) := X * 2 ^ N }
function fscale(X:Extended; N:integer):Extended;
begin
 Result:=Math.Ldexp(X,N);
end;

 {
 Extract exponent and mantissa from X: X=Mantissa*2^Exponent
 In FPC version 0.5<=Mantissa<1 (in CRW32 was 1<=Mantissa<2)
 }
procedure fxtract(X: Extended; var Mantissa: Extended; var Exponent: Integer);
begin
 Math.Frexp(X,Mantissa,Exponent);
end;

 {
 compress value to given number of significant bits
 if Argument=mantissa*2^exp, 1<=abs(mantissa)<2, then
 result=int(mantissa*2^NumberOfSignificantBits)*2^(exp-NumberOfSignificantBits)
 }
function fbitcompress(Argument:Extended; NumberOfSignificantBits:integer):Extended;
var Mantissa:Extended; Exponent:Integer;
begin
 Mantissa:=0.0; Exponent:=0;
 fxtract(Argument,Mantissa,Exponent);
 if (Mantissa<1.0) then inc(NumberOfSignificantBits);
 Result:=System.int(fscale(Mantissa,NumberOfSignificantBits));
 Result:=fscale(Result,Exponent-NumberOfSignificantBits);
end;


 {
 compress value to given relative tolerance
 if Argument=mantissa*2^exp, 1<=abs(mantissa)<2, then
 result=int(mantissa*ScaleFactor)/ScaleFactor*2^exp
 }
function frelcompress(Argument,ScaleFactor:Extended):Extended;
var Mantissa:Extended; Exponent:Integer;
begin
 Mantissa:=0.0; Exponent:=0;
 fxtract(Argument,Mantissa,Exponent);
 if (Mantissa<1.0) then ScaleFactor:=ScaleFactor*2;
 Result:=int(Mantissa*ScaleFactor)/ScaleFactor;
 Result:=fscale(Result,Exponent);
end;

 {
 compress value to given absolute tolerance
 result=int(Argument*ScaleFactor)/ScaleFactor
 }
function fabscompress(Argument,ScaleFactor:Extended):Extended;
begin
 Result:=System.int(Argument*ScaleFactor)/ScaleFactor;
end;

{$IF SizeOf(Extended)<>SizeOf(Double)}
function Sgn(x:Extended): Integer;
begin
 if x<0 then Result:=-1 else Result:=1;
end;
{$ENDIF}
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;

{$IF SizeOf(Extended)<>SizeOf(Double)}
function Sign(x:Extended): Integer;
begin
 if x>0 then Result:=1 else if x<0 then Result:=-1 else Result:=0
end;
{$ENDIF}
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;

{$IF SizeOf(Extended)<>SizeOf(Double)}
function Kronek(x:Extended): Integer;
begin
 if x=0 then Result:=1 else Result:=0;
end;
{$ENDIF}
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;

{$IF SizeOf(Extended)<>SizeOf(Double)}
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;
{$ENDIF}
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;

{$IF SizeOf(Extended)<>SizeOf(Double)}
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;
{$ENDIF}
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;

{$IF SizeOf(Extended)<>SizeOf(Double)}
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;
{$ENDIF}
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;

{$IF SizeOf(Extended)<>SizeOf(Double)}
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;
{$ENDIF}
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;

{$IF SizeOf(Extended)<>SizeOf(Double)}
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;
{$ENDIF}
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;

{$IF SizeOf(Extended)<>SizeOf(Double)}
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;
{$ENDIF}
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;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_ef;
begin
end;

procedure Free_crw_ef;
begin
end;

initialization

 Init_crw_ef;

finalization

 Free_crw_ef;

end.

//////////////
// END OF FILE
//////////////

