123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880 |
- {
- This file is part of the Pas2JS run time library.
- Copyright (c) 2017 by Mattias Gaertner
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit Math;
- {$mode objfpc}
- interface
- const
- MinInteger = -$fffffffffffff-1;
- MaxInteger = $fffffffffffff;
- MinDouble = 5.0e-324;
- MaxDouble = 1.7e+308;
- const
- NaN: Double; external name 'NaN';
- Infinity: Double; external name 'Infinity';
- NegInfinity: Double; external name '-Infinity';
- type
- float = double;
- //EInvalidArgument = class(EMathError);
- function Min(const a, b: Double): Double; varargs; external name 'Math.min'; overload;
- function Max(const a, b: Double): Double; varargs; external name 'Math.max'; overload;
- function Min(const a, b: NativeLargeUInt): NativeLargeUInt; varargs; external name 'Math.min'; overload;
- function Max(const a, b: NativeLargeUInt): NativeLargeUInt; varargs; external name 'Math.max'; overload;
- function Min(const a, b: NativeLargeInt): NativeLargeInt; varargs; external name 'Math.min'; overload;
- function Max(const a, b: NativeLargeInt): NativeLargeInt; varargs; external name 'Math.max'; overload;
- function Min(const a, b: Integer): Integer; varargs; external name 'Math.min'; overload;
- function Max(const a, b: Integer): Integer; varargs; external name 'Math.max'; overload;
- function InRange(const AValue, AMin, AMax: Integer): Boolean; assembler; overload;
- function InRange(const AValue, AMin, AMax: Double): Boolean; assembler; overload;
- function EnsureRange(const AValue, AMin, AMax: Integer): Integer; assembler; overload;
- function EnsureRange(const AValue, AMin, AMax: Double): Double; assembler; overload;
- type
- TRoundToRange = -37..37;
- function RoundTo(const AValue: Double; const Digits: TRoundToRange): Double;
- function SimpleRoundTo(const AValue: Double; const Digits: TRoundToRange = -2): Double;
- function randg(mean,stddev : float) : float;
- function RandomRange(const aFrom, aTo: Integer): Integer;
- function RandomRange(const aFrom, aTo: NativeLargeInt): NativeLargeInt;
- Type
- TValueSign = -1..1;
- const
- NegativeValue = -1;
- ZeroValue = 0;
- PositiveValue = 1;
- function Sign(const AValue: Integer): TValueSign; external name 'Math.sign'; overload;
- function Sign(const AValue: Double): TValueSign; external name 'Math.sign'; overload;
- function IsZero(const d: Double; Epsilon: Double): Boolean; overload;
- function IsZero(const d: Double): Boolean; overload;
- function IsNaN(const v: JSValue): boolean; external name {$IFDEF ECMAScript5}'isNaN'{$ELSE}'Number.isNaN'{$ENDIF}; overload;
- function IsFinite(const d: JSValue): Boolean; external name 'isFinite'; overload;// false if NaN, positive or negative infinity
- function IsInfinite(const d: JSValue): Boolean; assembler; overload; // negative or positive infinity
- {$IFDEF ECMAScript6}
- function IsInteger(const d: JSValue): Boolean; external name 'Number.isInteger'; // any integer representable by a double
- function IsSafeInteger(const d: JSValue): Boolean; external name 'Number.isSafeInteger'; // an integer between MinInteger and MaxInteger, inclusive
- {$ENDIF}
- function SameValue(const A, B: Double; Epsilon: Double = 0.0): Boolean; overload;
- // function Abs is in System.pas
- function ArcCos(const A : Double): Double; external name 'Math.acos';
- function ArcCosH(const A: Double): Double; external name 'Math.acosh'; // not on IE
- function ArcSin(const A : Double): Double; external name 'Math.asin';
- function ArcSinH(const A : Double): Double; external name 'Math.asinh'; // not on IE
- function ArcTanH(const A: Double): Double; external name 'Math.atanh'; // not on IE
- function CosH(const A: Double): Double; external name 'Math.cosh'; // not on IE
- function ExpM1(const A: Double): Double; external name 'Math.expm1'; // not on IE
- function FRound(const A: Double): Double; overload; external name 'Math.fround'; // not on IE
- function FTrunc(const A: Double): double; overload; external name 'Math.trunc'; // not on IE
- function Hypot(const A : Double): Double; varargs; external name 'Math.hypot'; // not on IE
- function IMul(const A, B: Integer): Integer; external name 'Math.imul'; // not on IE
- function Log10(const A: Double): Double; external name 'Math.log10';
- function Log1p(const A: Double): Double; external name 'Math.log1p'; // not on IE
- function Log2(const A: Double): Double; external name 'Math.log2'; // not on IE
- function LogN(const A, Base: Double): Double;
- function Power(const Base, Exponent: Double): Double; external name 'Math.pow';
- // ln, round, sqrt, trunc, cos, sin, arctan, round, exp are in unit system
- function Ceil(const A: Double): Integer;
- function Floor(const A: Double): Integer;
- function Ceil64(const A: Double): NativeLargeInt;
- function Floor64(const A: Double): NativeLargeInt;
- function ldexp(x : double;const p : Integer) : double;
- procedure Frexp(X: double; out Mantissa: double; out Exponent: integer);
- function lnxp1(x : double) : double;
- function IntPower(base : float;const exponent : Integer) : double;
- procedure DivMod(Dividend: LongInt; Divisor: Word; out Result, Remainder: Word);
- procedure DivMod(Dividend: LongInt; Divisor: Word; out Result, Remainder: SmallInt);
- procedure DivMod(Dividend: DWord; Divisor: DWord; out Result, Remainder: DWord);
- procedure DivMod(Dividend: LongInt; Divisor: LongInt; out Result, Remainder: LongInt);
- { Angle conversion }
- function DegToRad(deg : double) : double;
- function RadToDeg(rad : double) : double;
- function GradToRad(grad : double) : double;
- function RadToGrad(rad : double) : double;
- function DegToGrad(deg : double) : double;
- function GradToDeg(grad : double) : double;
- { one cycle are 2*Pi rad }
- function CycleToRad(cycle : double) : double;
- function RadToCycle(rad : double) : double;
- Function DegNormalize(deg : double) : double;
- function Norm(const data : array of double) : double;
- // Statistical functions
- function Mean(const data : array of double) : double;
- function Sum(const data : array of double) : double;
- procedure SumsAndSquares(const data : Array of Double; out Sum,SumOfSquares : double);
- function StdDev(const data : array of Double) : float;
- procedure MeanAndStdDev(const data : array of Double; out Mean,StdDev : double);
- function Variance(const data : array of Double) : double;
- function TotalVariance(const data : array of Double) : double;
- function PopNStdDev(const data : array of Double) : double;
- function PopNVariance(const data : array of Double) : double;
- procedure MomentSkewKurtosis(const data : array of Double; out m1,m2,m3,m4,skew,kurtosis : double);
- // Financial functions
- Type
- TPaymentTime = (ptEndOfPeriod,ptStartOfPeriod);
- function FutureValue(ARate: double; NPeriods: Integer;
- APayment, APresentValue: double; APaymentTime: TPaymentTime): double;
- function InterestRate(NPeriods: Integer; APayment, APresentValue, AFutureValue: double;
- APaymentTime: TPaymentTime): double;
- function NumberOfPeriods(ARate, APayment, APresentValue, AFutureValue: double;
- APaymentTime: TPaymentTime): double;
- function Payment(ARate: double; NPeriods: Integer;
- APresentValue, AFutureValue: double; APaymentTime: TPaymentTime): double;
- function PresentValue(ARate: double; NPeriods: Integer;
- APayment, AFutureValue: double; APaymentTime: TPaymentTime): double;
- // Miscellaneous
- function IfThen(val:boolean;const ifTrue:integer; const ifFalse:integer= 0) :integer; overload;
- function IfThen(val:boolean;const ifTrue:double ; const ifFalse:double =0.0):double; overload;
- Type
- TValueRelationship = -1..1;
- const
- EqualsValue = 0;
- LessThanValue = Low(TValueRelationship);
- GreaterThanValue = High(TValueRelationship);
- function CompareValue ( const A, B : Integer) : TValueRelationship;
- function CompareValue ( const A, B : NativeLargeInt) : TValueRelationship;
- function CompareValue ( const A, B : NativeLargeUInt) : TValueRelationship;
- function CompareValue ( const A, B : Double; delta : Double = 0.0) : TValueRelationship;
- implementation
- function InRange(const AValue, AMin, AMax: Integer): Boolean; assembler;
- asm
- return (AValue >= AMin) && (AValue <= AMax);
- end;
- function InRange(const AValue, AMin, AMax: Double): Boolean; assembler;
- asm
- return (AValue >= AMin) && (AValue <= AMax);
- end;
- function EnsureRange(const AValue, AMin, AMax: Integer): Integer; assembler;
- asm
- if (AValue<AMin){ return AMin;
- } else if (AValue>AMax){ return AMax;
- } else return AValue;
- end;
- function EnsureRange(const AValue, AMin, AMax: Double): Double; assembler;
- asm
- if (AValue<AMin){ return AMin;
- } else if (AValue>AMax){ return AMax;
- } else return AValue;
- end;
- function RoundTo(const AValue: Double; const Digits: TRoundToRange): Double;
- var
- RV : Double;
- begin
- RV:=IntPower(10,Digits);
- Result:=Round(AValue/RV)*RV;
- end;
- function SimpleRoundTo(const AValue: Double; const Digits: TRoundToRange): Double;
- var
- RV : Double;
- begin
- RV := IntPower(10, -Digits);
- if AValue < 0 then
- Result := Int((AValue*RV) - 0.5)/RV
- else
- Result := Int((AValue*RV) + 0.5)/RV;
- end;
- function randg(mean,stddev : float) : float;
- Var
- U1,S2 : Float;
- begin
- repeat
- u1:= 2*random-1;
- S2:=Sqr(U1)+sqr(2*random-1);
- until s2<1;
- Result:=Sqrt(-2*ln(S2)/S2)*u1*stddev+Mean;
- end;
- function RandomRange(const aFrom, aTo: Integer): Integer;
- begin
- Result:=Random(Abs(aFrom-aTo))+Min(aTo,AFrom);
- end;
- function RandomRange(const aFrom, aTo: NativeLargeInt): NativeLargeInt;
- Var
- m : NativeLargeInt;
- begin
- if aFrom<aTo then
- M:=aFrom
- else
- M:=aTo;
- Result:=Random(Abs(aFrom-aTo))+M;
- end;
- const
- DZeroResolution = 1E-12;
- function IsZero(const d: Double; Epsilon: Double): Boolean;
- begin
- if Epsilon=0 then
- Epsilon:=DZeroResolution;
- Result:=Abs(d)<=Epsilon;
- end;
- function IsZero(const d: Double): Boolean;
- begin
- Result:=Abs(d)<=DZeroResolution;
- end;
- function IsInfinite(const d: JSValue): Boolean; assembler;
- asm
- return (d==Infinity) || (d==-Infinity);
- end;
- function SameValue(const A, B: Double; Epsilon: Double): Boolean;
- begin
- if (Epsilon=0.0) then
- Epsilon:=Max(Min(Abs(A),Abs(B))*DZeroResolution,DZeroResolution);
- if (A>B) then
- Result:=((A-B)<=Epsilon)
- else
- Result:=((B-A)<=Epsilon);
- end;
- function JSFloor(const A: Double): Double; external name 'Math.floor';
- function JSCeil(const A: Double): Double; external name 'Math.ceil';
- function Ceil(const A: Double): Integer;
- begin
- // TODO: add Range check ?
- Result:=trunc(JSCeil(a));
- end;
- function Floor(const A: Double): Integer;
- begin
- // TODO: add Range check ?
- Result:=trunc(JSFloor(a));
- end;
- function Ceil64(const A: Double): NativeLargeInt;
- begin
- Result:=trunc(JSCeil(a));
- end;
- function Floor64(const A: Double): NativeLargeInt;
- begin
- Result:=trunc(JSCeil(a));
- end;
- procedure Frexp(X: double; out Mantissa: double; out Exponent: integer);
- begin
- Exponent:=0;
- if (X<>0) then
- if (abs(X)<0.5) then
- repeat
- X:=X*2;
- Dec(Exponent);
- until (abs(X)>=0.5)
- else
- while (abs(X)>=1) do
- begin
- X:=X/2;
- Inc(Exponent);
- end;
- Mantissa:=X;
- end;
- function LogN(const A, Base: Double): Double;
- begin
- Result:=Ln(A)/Ln(Base);
- end;
- function lnxp1(x: double): double;
- var
- y: float;
- begin
- if (x>=4.0) then
- result:=ln(1.0+x)
- else
- begin
- y:=1.0+x;
- if (y=1.0) then
- result:=x
- else
- begin
- result:=ln(y); { lnxp1(-1) = ln(0) = -Inf }
- if y>0.0 then
- result:=result+(x-(y-1.0))/y;
- end;
- end;
- end;
- function ldexp(x : double;const p : Integer) : double;
- begin
- result:=x*intpower(2.0,p);
- end;
- function IntPower(base: float; const exponent: Integer): double;
- var
- i : longint;
- begin
- if (base = 0.0) and (exponent = 0) then
- result:=1
- else
- begin
- i:=abs(exponent);
- Result:=1.0;
- while i>0 do
- begin
- while (i and 1)=0 do
- begin
- i:=i shr 1;
- base:=sqr(base);
- end;
- i:=i-1;
- Result:=Result*base;
- end;
- if exponent<0 then
- Result:=1.0/Result;
- end;
- end;
- procedure DivMod(Dividend: LongInt; Divisor: Word; out Result, Remainder: Word);
- begin
- if Dividend < 0 then
- begin
- Dividend:=-Dividend;
- Result:=-(Dividend Div Divisor);
- Remainder:=-(Dividend+(Result*Divisor));
- end
- else
- begin
- Result:=Dividend Div Divisor;
- Remainder:=Dividend-(Result*Divisor);
- end;
- end;
- procedure DivMod(Dividend: LongInt; Divisor: Word; out Result,
- Remainder: SmallInt);
- begin
- if Dividend < 0 then
- begin
- Dividend:=-Dividend;
- Result:=-(Dividend Div Divisor);
- Remainder:=-(Dividend+(Result*Divisor));
- end
- else
- begin
- Result:=Dividend Div Divisor;
- Remainder:=Dividend-(Result*Divisor);
- end;
- end;
- procedure DivMod(Dividend: DWord; Divisor: DWord; out Result, Remainder: DWord);
- begin
- Result:=Dividend Div Divisor;
- Remainder:=Dividend-(Result*Divisor);
- end;
- procedure DivMod(Dividend: LongInt; Divisor: LongInt; out Result,
- Remainder: LongInt);
- begin
- if Dividend < 0 then
- begin
- Dividend:=-Dividend;
- Result:=-(Dividend Div Divisor);
- Remainder:=-(Dividend+(Result*Divisor));
- end
- else
- begin
- Result:=Dividend Div Divisor;
- Remainder:=Dividend-(Result*Divisor);
- end;
- end;
- { ---------------------------------------------------------------------
- Angle conversion
- ---------------------------------------------------------------------}
- function DegToRad(deg: double): double;
- begin
- Result:=deg*(pi/180.0);
- end;
- function RadToDeg(rad: double): double;
- begin
- Result:=rad*(180.0/pi);
- end;
- function GradToRad(grad: double): double;
- begin
- Result:=grad*(pi/200.0);
- end;
- function RadToGrad(rad: double): double;
- begin
- Result:=rad*(200.0/pi);
- end;
- function DegToGrad(deg: double): double;
- begin
- Result:=deg*(200.0/180.0);
- end;
- function GradToDeg(grad: double): double;
- begin
- Result:=grad*(180.0/200.0);
- end;
- function CycleToRad(cycle: double): double;
- begin
- Result:=(2*pi)*cycle;
- end;
- function RadToCycle(rad: double): double;
- begin
- Result:=rad*(1/(2*pi));
- end;
- function DegNormalize(deg: double): double;
- begin
- Result:=Deg-Int(Deg/360)*360;
- If (Result<0) then Result:=Result+360;
- end;
- function sumofsquares(const data : array of double) : double;
- var
- i,N : longint;
- begin
- N:=Length(Data);
- Result:=0.0;
- for i:=0 to N-1 do
- Result:=Result+sqr(data[i]);
- end;
- function Norm(const data: array of double): double;
- begin
- Result:=sqrt(sumofsquares(data));
- end;
- { ---------------------------------------------------------------------
- Statistical functions
- ---------------------------------------------------------------------}
- function Sum(const data: array of double): double;
- var
- i,N : longint;
- begin
- N:=Length(Data);
- Result:=0.0;
- for i:=0 to N-1 do
- Result:=Result+data[i];
- end;
- function Mean(const data: array of double): double;
- Var
- N : integer;
- begin
- N:=Length(Data);
- if N=0 then
- Result:=0
- else
- Result:=Sum(Data)/N;
- end;
- procedure SumsAndSquares(const data: array of Double; out Sum,
- SumOfSquares: double);
- var
- i,n : Integer;
- t,s,ss: double;
- begin
- n:=length(Data);
- ss:=0.0; // Use local vars, var is very inefficient in js
- s:=0.0;
- for i:=0 to N-1 do
- begin
- t:=data[i];
- ss:=ss+sqr(t);
- s:=s+t;
- end;
- Sum:=s;
- SumOfSquares:=ss;
- end;
- function StdDev(const data: array of Double): float;
- begin
- Result:=Sqrt(Variance(Data));
- end;
- function Variance(const data: array of Double): double;
- var
- n : integer;
- begin
- N:=Length(Data);
- If N=1 then
- Result:=0
- else
- Result:=TotalVariance(Data)/(N-1);
- end;
- function TotalVariance(const data: array of Double): double;
- var
- S,SS : Float;
- N : integer;
- begin
- N:=Length(Data);
- If Length(Data)=1 then
- Result:=0
- else
- begin
- SumsAndSquares(Data,S,SS);
- Result := SS-Sqr(S)/N;
- end;
- end;
- procedure MeanAndStdDev(const data: array of Double; out Mean, StdDev: double);
- Var
- I,N : longint;
- M,S : Double;
- begin
- N:=Length(Data);
- M:=0;
- S:=0;
- For I:=0 to N-1 do
- begin
- M:=M+Data[i];
- S:=S+Sqr(Data[i]);
- end;
- M:=M/N;
- S:=(S-N*Sqr(M));
- If N>1 then
- S:=Sqrt(S/(N-1))
- else
- S:=0;
- Mean:=M;
- StdDev:=S;
- end;
- function PopNStdDev(const data : array of Double) : double;
- begin
- Result:=Sqrt(PopnVariance(Data));
- end;
- function PopNVariance(const data : array of Double) : double;
- Var
- N : integer;
- begin
- N:=Length(Data);
- if N=0 then
- Result:=0
- else
- Result:=TotalVariance(Data)/N;
- end;
- procedure MomentSkewKurtosis(const data: array of Double; out m1, m2, m3, m4, skew, kurtosis: double);
- var
- i,N: integer;
- deviation, deviation2: double;
- reciprocalN: float;
- // Use local vars for all calculations, var is very slow
- lm1, lm2, lm3, lm4, lskew, lkurtosis: double;
- begin
- N:=length(Data);
- lm1 := 0;
- reciprocalN := 1/N;
- for i := 0 to N-1 do
- lm1 := lm1 + data[i];
- lm1 := reciprocalN * lm1;
- lm2 := 0;
- lm3 := 0;
- lm4 := 0;
- for i := 0 to N-1 do
- begin
- deviation := (data[i]-lm1);
- deviation2 := deviation * deviation;
- lm2 := lm2 + deviation2;
- lm3 := lm3 + deviation2 * deviation;
- lm4 := lm4 + deviation2 * deviation2;
- end;
- lm2 := reciprocalN * lm2;
- lm3 := reciprocalN * lm3;
- lm4 := reciprocalN * lm4;
- lskew := lm3 / (sqrt(lm2)*lm2);
- lkurtosis := lm4 / (lm2 * lm2);
- m1:=lm1;
- m2:=lm2;
- m3:=lm3;
- m4:=lm4;
- skew:=lskew;
- kurtosis:=lkurtosis;
- end;
- { ---------------------------------------------------------------------
- Financial functions
- ---------------------------------------------------------------------}
- function FutureValue(ARate: double; NPeriods: Integer;
- APayment, APresentValue: double; APaymentTime: TPaymentTime): double;
- var
- q, qn, factor: double;
- begin
- if ARate = 0 then
- Result := -APresentValue - APayment * NPeriods
- else begin
- q := 1.0 + ARate;
- qn := power(q, NPeriods);
- factor := (qn - 1) / (q - 1);
- if APaymentTime = ptStartOfPeriod then
- factor := factor * q;
- Result := -(APresentValue * qn + APayment*factor);
- end;
- end;
- function InterestRate(NPeriods: Integer; APayment, APresentValue, AFutureValue: double;
- APaymentTime: TPaymentTime): double;
- { The interest rate cannot be calculated analytically. We solve the equation
- numerically by means of the Newton method:
- - guess value for the interest reate
- - calculate at which interest rate the tangent of the curve fv(rate)
- (straight line!) has the requested future vale.
- - use this rate for the next iteration. }
- const
- DELTA = 0.001;
- EPS = 1E-9; // required precision of interest rate (after typ. 6 iterations)
- MAXIT = 20; // max iteration count to protect agains non-convergence
- var
- r1, r2, dr: double;
- fv1, fv2: double;
- iteration: Integer;
- begin
- iteration := 0;
- r1 := 0.05; // inital guess
- repeat
- r2 := r1 + DELTA;
- fv1 := FutureValue(r1, NPeriods, APayment, APresentValue, APaymentTime);
- fv2 := FutureValue(r2, NPeriods, APayment, APresentValue, APaymentTime);
- dr := (AFutureValue - fv1) / (fv2 - fv1) * delta; // tangent at fv(r)
- r1 := r1 + dr; // next guess
- inc(iteration);
- until (abs(dr) < EPS) or (iteration >= MAXIT);
- Result := r1;
- end;
- function NumberOfPeriods(ARate, APayment, APresentValue, AFutureValue: double;
- APaymentTime: TPaymentTime): double;
- { Solve the cash flow equation (1) for q^n and take the logarithm }
- var
- q, x1, x2: double;
- begin
- if ARate = 0 then
- Result := -(APresentValue + AFutureValue) / APayment
- else begin
- q := 1.0 + ARate;
- if APaymentTime = ptStartOfPeriod then
- APayment := APayment * q;
- x1 := APayment - AFutureValue * ARate;
- x2 := APayment + APresentValue * ARate;
- if (x2 = 0) // we have to divide by x2
- or (sign(x1) * sign(x2) < 0) // the argument of the log is negative
- then
- Result := Infinity
- else begin
- Result := ln(x1/x2) / ln(q);
- end;
- end;
- end;
- function Payment(ARate: double; NPeriods: Integer;
- APresentValue, AFutureValue: double; APaymentTime: TPaymentTime): double;
- var
- q, qn, factor: double;
- begin
- if ARate = 0 then
- Result := -(AFutureValue + APresentValue) / NPeriods
- else begin
- q := 1.0 + ARate;
- qn := power(q, NPeriods);
- factor := (qn - 1) / (q - 1);
- if APaymentTime = ptStartOfPeriod then
- factor := factor * q;
- Result := -(AFutureValue + APresentValue * qn) / factor;
- end;
- end;
- function PresentValue(ARate: double; NPeriods: Integer;
- APayment, AFutureValue: double; APaymentTime: TPaymentTime): double;
- var
- q, qn, factor: double;
- begin
- if ARate = 0.0 then
- Result := -AFutureValue - APayment * NPeriods
- else begin
- q := 1.0 + ARate;
- qn := power(q, NPeriods);
- factor := (qn - 1) / (q - 1);
- if APaymentTime = ptStartOfPeriod then
- factor := factor * q;
- Result := -(AFutureValue + APayment*factor) / qn;
- end;
- end;
- { ---------------------------------------------------------------------
- Miscellaneous
- ---------------------------------------------------------------------}
- function IfThen(val: boolean; const ifTrue: integer; const ifFalse: integer): integer;
- begin
- if val then result:=iftrue else result:=iffalse;
- end;
- function IfThen(val: boolean; const ifTrue: double; const ifFalse: double): double;
- begin
- if val then result:=iftrue else result:=iffalse;
- end;
- function CompareValue(const A, B : Integer): TValueRelationship;
- begin
- result:=GreaterThanValue;
- if a=b then
- result:=EqualsValue
- else
- if a<b then
- result:=LessThanValue;
- end;
- function CompareValue(const A, B: NativeLargeInt): TValueRelationship;
- begin
- result:=GreaterThanValue;
- if a=b then
- result:=EqualsValue
- else
- if a<b then
- result:=LessThanValue;
- end;
- function CompareValue(const A, B: NativeLargeUInt): TValueRelationship;
- begin
- result:=GreaterThanValue;
- if a=b then
- result:=EqualsValue
- else
- if a<b then
- result:=LessThanValue;
- end;
- function CompareValue(const A, B: Double; delta: Double): TValueRelationship;
- begin
- result:=GreaterThanValue;
- if abs(a-b)<=delta then
- result:=EqualsValue
- else
- if a<b then
- result:=LessThanValue;
- end;
- end.
|