3
*****************************************************************************
5
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
6
* for details about the copyright. *
8
* This program is distributed in the hope that it will be useful, *
9
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
10
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
12
*****************************************************************************
14
Authors: Alexander Klenin, Werner Pamler
26
function CumulNormDistr(AX: Double): Double;
27
function InvCumulNormDistr(AX: Double): Double;
29
procedure EnsureOrder(var A, B: Integer); overload; inline;
30
procedure EnsureOrder(var A, B: Double); overload; inline;
32
procedure ExpandRange(var ALo, AHi: Double; ACoeff: Double);
34
function InRangeUlps(AX, ALo, AHi: Double; AMaxUlps: Word): Boolean;
36
function SafeInfinity: Double; inline;
37
function SafeInRange(AValue, ABound1, ABound2: Double): Boolean;
38
function SafeMin(A, B: Double): Double;
39
function SafeNan: Double; inline;
44
Math, spe, TAChartUtils;
46
function Ulps(AX: Double): Int64; forward;
48
// Cumulative normal distribution
49
// x = -INF ... INF --> Result = 0 ... 1
50
function CumulNormDistr(AX: Double): Double;
53
Result := (speerf(AX / Sqrt(2)) + 1) * 0.5
55
Result := (1 - speerf(-AX / Sqrt(2))) * 0.5
60
// Inverse cumulative normal distribution.
61
// x = 0 ... 1 --> Result = -INF ... +INF
62
// Algorithm by Peter John Acklam.
63
// http://home.online.no/~pjacklam/notes/invnorm/index.html
64
function InvCumulNormDistr(AX: Double): Double;
66
A: array[1..6] of Double = (
67
-3.969683028665376e+01,
68
+2.209460984245205e+02,
69
-2.759285104469687e+02,
70
+1.383577518672690e+02,
71
-3.066479806614716e+01,
72
+2.506628277459239e+00
74
B: array[1..5] of Double = (
75
-5.447609879822406e+01,
76
+1.615858368580409e+02,
77
-1.556989798598866e+02,
78
+6.680131188771972e+01,
79
-1.328068155288572e+01
81
C: array[1..6] of Double = (
82
-7.784894002430293e-03,
83
-3.223964580411365e-01,
84
-2.400758277161838e+00,
85
-2.549732539343734e+00,
86
+4.374664141464968e+00,
87
+2.938163982698783e+00
89
D: array[1..4] of Double = (
90
+7.784695709041462e-03,
91
+3.224671290700398e-01,
92
+2.445134137142996e+00,
93
+3.754408661907416e+00
95
// Switching points between regions.
102
Result := NegInfinity
103
else if AX < P_LOW then begin
104
// Rational approximation for lower region.
105
q := Sqrt(-2 * Ln(AX));
107
(((((C[1] * q + C[2]) * q + C[3]) * q + C[4]) * q + C[5]) * q + C[6]) /
108
((((D[1] * q + D[2]) * q + D[3]) * q + D[4]) * q + 1);
110
else if AX <= P_HIGH then begin
111
// Rational approximation for central region.
115
(((((A[1] * r + A[2]) * r + A[3]) * r + A[4]) * r + A[5]) * r + A[6]) * q /
116
(((((B[1] * r + B[2]) * r + B[3]) * r + B[4]) * r + B[5]) * r + 1);
118
else if AX < 1 then begin
119
// Rational approximation for upper region.
120
q := Sqrt(-2 * Ln(1 - AX));
122
-(((((C[1] * q + C[2]) * q + C[3]) * q + C[4]) * q + C[5]) * q + C[6]) /
123
((((D[1] * q + D[2]) * q + D[3]) * q + D[4]) * q + 1);
125
Result := SafeInfinity;
128
procedure EnsureOrder(var A, B: Integer); overload; inline;
134
procedure EnsureOrder(var A, B: Double); overload; inline;
140
procedure ExpandRange(var ALo, AHi: Double; ACoeff: Double);
144
if IsInfinite(ALo) or IsInfinite(AHi) then exit;
150
function InRangeUlps(AX, ALo, AHi: Double; AMaxUlps: Word): Boolean;
152
Result := InRange(Ulps(AX), Ulps(ALo) - AMaxUlps, Ulps(AHi) + AMaxUlps);
155
function SafeInfinity: Double;
162
function SafeInRange(AValue, ABound1, ABound2: Double): Boolean;
164
EnsureOrder(ABound1, ABound2);
165
Result := InRange(AValue, ABound1, ABound2);
168
function SafeMin(A, B: Double): Double;
172
else if IsNan(B) then
180
function SafeNan: Double;
187
// Convert double value to integer 2's complement representation.
188
// Difference between resulting integers can be interpreted as distance in ulps.
189
function Ulps(AX: Double): Int64; inline;
193
Result := (1 shl 63) - Result;