I have been looking for usable and full code for chi-square distribution in Delphi. There are some codes via net, but usually they don't work or have missing parts, do not compile etc.. There are also some libraries, but I'm interested about some code that I just can simply implement.
I've found something almost working. Some german parts have been fixed, it compiles and it gives p-values for most of the data:
function LnGamma (x : Real) : Real;
const
a0 = 0.083333333096;
a1 = -0.002777655457;
a2 = 0.000777830670;
c = 0.918938533205;
var
r : Real;
begin
r := (a0 + (a1 + a2 / sqr(x)) / sqr(x)) / x;
LnGamma := (x - 0.5) * ln(x) - x + c + r;
end;
function LnFak (x : Real) : Real;
var
z : Real;
begin
z := x+1;
LnFak := LnGamma(z);
end;
function Reihe (chi : Real; f : Real) : Real;
const MaxError = 0.0001;
var
Bruch,
Summe,
Summand : Real;
k, i : longint;
begin
Summe := 1;
k := 1;
repeat
Bruch := 1;
for i := 1 to k do
Bruch := Bruch * (f + 2 * i);
Summand := power(chi, 2 * k) / Bruch;
Summe := Summe + Summand;
k := succ(k);
until (Summand < MaxError);
Reihe := Summe;
end;
function IntegralChi (chisqr : Real; f : longint) : Real;
var
s : Real;
begin
S := power((0.5 * chisqr), f/2) * Reihe(sqrt(chisqr), f)
* exp((-chisqr/2) - LnGamma((f + 2) / 2));
IntegralChi := 1 - s;
end;
It works quite good for relatively big results.
For example:
For Chi = 1.142132 and df = 1 I'm getting p about 0.285202, which is perfect. Same as SPSS result or other programs.
But for example Chi = 138.609137 and df = 4 I should recieive something about 0.000000, but I'm getting floating point overflow error in Reiche function. Summe and Summand are very big then.
I admit that understanding distribution function is not my strong point, so maybe someone will tell me what I did wrong?
Thank you very much for the information
You should debug your program and find that there is an overflow
in your loop for k=149. For k=148 the value of Bruch is 3.3976725289e+304. The next computation of Bruch overflows. A fix is to code
for i := 1 to k do
Bruch := Bruch / (f + 2 * i);
Summand := power(chi, 2 * k) * Bruch;
With this change you get the value IntegralChi(138.609137,4) = 1.76835197E-7 after 156th iteration.
Note that your computation (even for this simple algorithm) is sub-optimal
because you compute the Bruch value over and over again. Just update it once
per loop:
function Reihe (chi : Real; f : Real) : Real;
const MaxError = 0.0001;
var
Bruch,
Summe,
Summand : Real;
k : longint;
begin
Summe := 1;
k := 1;
Bruch := 1;
repeat
Bruch := Bruch / (f + 2 * k);
Summand := power(chi, 2 * k) * Bruch;
Summe := Summe + Summand;
k := succ(k);
until (Summand < MaxError);
Reihe := Summe;
end;
Similar consideration should be applied to compute power(chi, 2*k) and then combine this with the improved evaluation of Bruch.
Edit: As a response to your comment, here the improved version based on the property of the power function, that is power(chi, 2*(k+1)) = power(chi, 2*k)*sqr(chi)
function Reihe (chi : Real; f : Real) : Real;
const MaxError = 0.0001;
var
chi2,
Summe,
Summand : Real;
k : longint;
begin
Summe := 1;
k := 1;
Summand := 1;
chi2 := sqr(chi);
repeat
Summand := Summand * chi2 / (f + 2 * k);
Summe := Summe + Summand;
k := succ(k);
until (Summand < MaxError);
Reihe := Summe;
end;
Related
In Delphi one can calculate Skewness using System.Math's function MomentSkewKurtosis().
var m1, m2, m3, m4, skew, k: Extended;
System.Math.MomentSkewKurtosis([1.1,
3.345,
12.234,
11.945,
14.235,
16.876,
20.213,
11.001,
7.098,
21.234], m1, m2, m3, m4, skew, k);
This will prints skew equal to -0.200371489809269.
Minitab prints the value -0.24
SigmaXL prints the value -0.23611
The reason is that Delphi does not not perform adjustment.
Here is my implementation which calculates adjustment:
function Skewness(const X: array of Extended; const Adjusted: Boolean): Extended;
begin
var AMean := Mean(X);
var xi_minus_mean_power_3 := 0.0;
var xi_minus_mean_power_2 := 0.0;
for var i := Low(X) to High(X) do
begin
xi_minus_mean_power_3 := xi_minus_mean_power_3 + IntPower((X[i] - AMean), 3);
xi_minus_mean_power_2 := xi_minus_mean_power_2 + IntPower((X[i] - AMean), 2);
end;
// URL : https://www.gnu.org/software/octave/doc/v4.0.1/Descriptive-Statistics.html
{ mean ((x - mean (x)).^3)
skewness (X) = ------------------------.
std (x).^3
}
var N := Length(X);
Result := xi_minus_mean_power_3 / N /
IntPower(Sqrt(1 / N * xi_minus_mean_power_2), 3);
// URL : https://www.gnu.org/software/octave/doc/v4.0.1/Descriptive-Statistics.html
{ sqrt (N*(N-1)) mean ((x - mean (x)).^3)
skewness (X, 0) = -------------- * ------------------------.
(N - 2) std (x).^3
}
if Adjusted then
Result := Result * Sqrt(N * Pred(N)) / (N - 2);
end;
The helper routine IntPower is as follows:
function IntPower(const X: Extended; const N: Integer): Extended;
/// <remarks>
/// Calculate any float to non-negative integer power. Developed by Rory Daulton and used with permission. Last modified December 1998.
/// </remarks>
function IntPow(const Base: Extended; const Exponent: LongWord): Extended;
{ Heart of Rory Daulton's IntPower: assumes valid parameters &
non-negative exponent }
{$IFDEF WIN32}
asm
fld1 // Result := 1
cmp eax, 0 // eax := Exponent
jz ##3
fld Base
jmp ##2
##1: fmul ST, ST // X := Base * Base
##2: shr eax,1
jnc ##1
fmul ST(1),ST // Result := Result * X
jnz ##1
fstp st // pop X from FPU stack
##3:
fwait
end;
{$ENDIF}
{$IFDEF WIN64}
begin
Result := Power(Base, Exponent);
end;
{$ENDIF}
begin
if N = 0 then
Result := 1
else if (X = 0) then
begin
if N < 0 then
raise EMathError.Create('Zero cannot be raised to a negative power.')
else
Result := 0
end
else if (X = 1) then
Result := 1
else if X = -1 then
begin
if Odd (N) then
Result := -1
else
Result := 1
end
else if N > 0 then
Result := IntPow (X, N)
else
begin
var P: LongWord;
if N <> Low (LongInt) then
P := Abs(N)
else
P := LongWord(High(LongInt)) + 1;
try
Result := IntPow(X, P);
except
on EMathError do
begin
Result := IntPow(1 / X, P); // try again with another method, perhaps less precise
Exit;
end;
end;
Result := 1 / Result;
end;
end;
With that function the adjusted skewness becomes the accurate -0.237611357234441 matching Matlab and Minitab.
The only explanation I found is:
https://octave.org/doc/v4.0.1/Descriptive-Statistics.html
"The adjusted skewness coefficient is obtained by replacing the sample
second and third central moments by their bias-corrected versions."
Same goes with Kurtosis:
function Kurtosis(const X: array of Extended; const Adjusted: Boolean): Extended;
begin
var AMean := Mean(X);
var xi_minus_mean_power_4 := 0.0;
var xi_minus_mean_power_2 := 0.0;
for var i := Low(X) to High(X) do
begin
xi_minus_mean_power_4 := xi_minus_mean_power_4 + IntPower((X[i] - AMean), 4);
xi_minus_mean_power_2 := xi_minus_mean_power_2 + IntPower((X[i] - AMean), 2);
end;
{ mean ((x - mean (x)).^4)
k1 = ------------------------
std (x).^4
}
var N := Length(X);
Result := xi_minus_mean_power_4 / N /
IntPower(1 / N * xi_minus_mean_power_2, 2);
{ N - 1
k0 = 3 + -------------- * ((N + 1) * k1 - 3 * (N - 1))
(N - 2)(N - 3)
}
if Adjusted then
// Mathlab, Minitab and SigmaXL do not add 3 (which is the kurtosis for normal distribution
Result := {3 + }(N - 1) / ((N - 2) * (N - 3)) * ((N + 1) * Result - 3 * (N - 1));
end;
What is the reason for such adjustments and why Delphi decided not to implement it?
I have a time problem with my program. Given a set of points, it has to say whether all of those points are lying on two different lines.
I wrote code, which has points in array and removes one by one and try calculate it's vector.
But this solution is slow, because it must control all cases of lines. On input with 10,000 points it takes over 10 seconds.
Can someone please tell me if, is here better solution for this problem?
I made this code in Pascal:
uses
math;
type
TPoint = record
x, y: real;
end;
TList = array of TPoint;
function xround(value: real; places: integer): real;
var
muldiv: real;
begin
muldiv := power(10, places);
xround := round(value * muldiv) / muldiv;
end;
function samevec(A, B, C: TPoint): boolean;
var
bx, by: real; // vec A -> B
cx, cy: real; // vec A -> C
lb, lc: real; // len AB, len AC
begin
bx := B.x - A.x;
by := B.y - A.y;
cx := C.x - A.x;
cy := C.y - A.y;
lb := sqrt(bx * bx + by * by);
lc := sqrt(cx * cx + cy * cy);
// normalize
bx := xround(bx / lb, 3);
by := xround(by / lb, 3);
cx := xround(cx / lc, 3);
cy := xround(cy / lc, 3);
samevec := ((bx = cx) and (by = cy)) or ((bx = -cx) and (by = -cy));
end;
function remove(var list: TList; idx: integer): TPoint;
var
i: integer;
begin
remove.x := 0;
remove.y := 0;
if idx < length(list) then
begin
remove := list[idx];
for i := idx to length(list) - 2 do
list[i] := list[i + 1];
setlength(list, length(list) - 1);
end;
end;
var
i, j, lines: integer;
list, work: TList;
A, B: TPoint;
begin
while not eof(input) do
begin
setlength(list, length(list) + 1);
with list[length(list) - 1] do
readln(x, y);
end;
if length(list) < 3 then
begin
writeln('ne');
exit;
end;
lines := 0;
for i := 1 to length(list) - 1 do
begin
work := copy(list, 0, length(list));
lines := 1;
B := remove(work, i);
A := remove(work, 0);
for j := length(work) - 1 downto 0 do
if samevec(A, B, work[j]) then
remove(work, j);
if length(work) = 0 then
break;
lines := 2;
A := remove(work, 0);
B := remove(work, 0);
for j := length(work) - 1 downto 0 do
if samevec(A, B, work[j]) then
remove(work, j);
if length(work) = 0 then
break;
lines := 3; // or more
end;
if lines = 2 then
writeln('YES')
else
writeln('NO');
end.
Thanks, Ferko
APPENDED:
program line;
{$APPTYPE CONSOLE}
uses
math,
sysutils;
type point=record
x,y:longint;
end;
label x;
var
Points,otherPoints:array[0..200001] of point;
n,n2,i,j,k,i1,i2:longint;
function sameLine(A,B,C:point):boolean;
var
ABx,ACx,ABy,ACy,k:longint;
begin
ABx:=B.X-A.X;
ACx:=C.X-A.X;
ABy:=B.Y-A.Y;
ACy:=C.Y-A.Y;
k:=ABx*ACy-ABy*ACx;
if (k=0) then sameLine:=true
else sameLine:=false;
end;
begin
readln(n);
if (n<=4) then begin
writeln('YES');
halt;
end;
for i:=1 to n do readln(Points[i].x,Points[i].y);
for i:=1 to 5 do for j:=i+1 to 5 do for k:=j+1 to 5 do if not (sameLine(Points[i],Points[j],Points[k])) then begin
i1:=i;
i2:=j;
goto x;
end;
writeln('NO');
halt;
x:
n2:=0;
for i:=1 to n do begin
if ((i=i1) or (i=i2)) then continue;
if not sameLine(Points[i1],Points[i2],Points[i]) then begin
inc(n2,1);
otherPoints[n2]:=Points[i];
end;
end;
if (n2<=2) then begin
writeln('YES');
halt;
end;
for i:=3 to n2 do begin
if not sameLine(otherPoints[1],otherPoints[2],otherPoints[i]) then begin
writeln('NO');
halt;
end;
end;
writeln('YES');
end.
Three points A, B and C lie on the same straight line, if vectors AB and AC are collinear or anti-collinear. We can check for collinearity using cross product of vectors - it should be zero.
#LU RD already described this approach is comment, but author probably missed it.
Note that method doesn't suffer from division by zero - there is no division at all.
ABx := B.X - A.X;
ACx := C.X - A.X;
ABy := B.Y - A.Y;
ACy := C.Y - A.Y;
Cross := ABx * ACy - ABy * ACx;
// for integer coordinates
if Cross = 0 then
A,B,C are collinear
If coordinates are float, one must consider some tolerance level. Variants:
//better if available:
if Math.IsZero(Cross)
if Math.SameValue(Cross, 0)
//otherwise
if Abs(Cross) <= SomeEpsilonValue
If coordinate range is very large, numerical error might be significant, so it is worth to normalize tolerance by squared magnitude of coordinate differences:
if Math.IsZero(Cross / Max(ABx * ABx + ABy * ABy, ACx * ACx + ACy * ACy))
I guess the answer to the Q should be devided into two parts.
I. How to know that the given three points belong to the same line?
The answer to this part of the Q was given by #Lurd and then expanded by Mbo.
Let us name their solution function BelongToOneLine(Pnts: array [1..3] of TPoint): boolean; We can consider this part solved.
II. How to decrease time consumption of the algorithm or in other words: how to avoid calling BelongToOneLilne with every possible combination of points as parameters?
Here is the algorithm.
We select 5 distinct points from the task set. 5 is enough (check combination possibilities).
We find the answer to the question if there are at least three points from given five that belong to a single line.
if No - then we do not need to iterate the remaining poins - the answer is that we require more then two lines.
if Yes - (say poins Pt1, Pt2 and Pt3 belong to the same line and Pt4 and Pt5 - don't).
Then we store the points that do not belong to the line Pt1-Pt2-Pt3 from the group-of-five in a distinct array of "outsider" points (or store their indexes in the main array). It may have Length = 0 by the end of this step. This will not affect the rest of the algo.
We get the boolean result of the function BelongToOneLine([Pt1, Pt2, Pt[i]]).
if Yes - we skip the point - it belongs to the line Pt1-Pt2-Pt3.
if No - we store this point in the "outsiders" array.
We watch the length of the OutsidersArray.
if it is <= 2 then the answer to the whole Q is Yes, they do belong to 2 or less lines.
if >2 then we iterate the function BelongToOneLine([OutsiderPt1, OutsiderPt2, OutsiderPt[i]]) until High(OutsiderArray) or until when OutsiderPt[i] does not belong to OutsiderPt1-OutsiderPt2 line. All points of OutsiderArray must belong to the same line otherwise the answer to the whole Q will be negative.
Math note
Without optimization the inerations count will be n! / ((n - k)! * k!).
With the optimization it will be:
5! / ((5-3)! * 3!) + (n - 3) + P(q)outsiders * n that is about 15000 for n = 10000. Most negative count - about 20000.
And another optimization note
Replace declaration of TPoint with integer variables.
Search Results
Featured snippet from the web
For n=1: you need two lines to intersect, so the maximum number of intersections is 0. n=2: Two distinct lines will always intersect in at most one point irrespective of dimensions. ... Explanation: Each set of 2 lines can intersect at one point. Or one point is common intersection for 2 lines.
I have this source code in Delphi, why I get this error "Floating point overflow." when I run the code? and how to correct it?
The error message:
The code:
procedure TForm1.Button1Click(Sender: TObject);
var n, d, i, j, maxiter , iter: Integer;
Lower,Upper : Double;
X, V : TArray<TArray<Double>>;
begin
Lower := 0;
Upper := 0.2;
n := 100;
d := 55;
SetLength(V, n, d);
SetLength(X, n, d);
maxiter := 2000;
iter := 1;
for i:= 0 n-1 do
for j:=0 to d-1 do
begin
X[i][j]:= Lower + (Upper - Lower) * Random;
V[i][j] := 0.1 * X[i][j];
end;
while (iter <= maxiter) do
begin
for i:= 0 to n-1 do
for j:= 0 to D-1 do
V[i][j]:= 5 * V[i][j] + 2.0 * Random;
iter := iter +1;
end;
end;
Look here: V[i][j]:= 5 * V[i][j] + 2.0 * Random;
You make 2000 iterations, so your results might be as large as 7^2000 ~ 10^1690, but max value for Double type is about 10^308. So “Floating point overflow” error is exact diagnosis.
You could see V[] values about 10^307 in debug watch or immediate watch (mouse over V[]) when error occurred.
You can use 10-byte Extended type(probably not available for 64-bit compilers) to avoid overflow for these given variable values, but this is not good solution in general case.
Aside note: You did not set i index value for this code piece:
for j:=0 to d-1 do
begin
X[i][j]:= Lower + (Upper - Lower) * Random;
V[i][j] := 0.1 * X[i][j];
end;
From Lenze manual
Code number (C1, C2)
Standard addressing
The meaning of the code numbers and the assigned parameters can be obtained from
the code table (see chapter 8.2). When transmitting data, the code number are
coded as follows:
The following calculation determines the two ASCII digits from the code number
(value range: 0..6229) (value range: 48dec 127dec):
C1 = INTEGER((REMAINDER(code number/790))/10) + 48dec
C2 = REMAINDER(REMAINDER(code number/790)/10) +
INTEGER(code number/790) x 10 + 48dec
Procedure for calculating C1 and C2 from codenumber.
procedure pCodeNumberToC1C2(CodeNumber: Word; var C1, C2: Byte);
begin
C1 := Byte((CodeNumber mod 790) div 10) + 48;
C2 := ((CodeNumber mod 790) mod 10) + 48 + 10 * Byte(CodeNumber div 790);
end;
But, how to calculate it the other way without the aweful:
function fC1C2ToCodeNumber(iC1, iC2: Byte): Word;
var
C1, C2: Byte;
i: Integer;
Begin
Result := 0;
For i := 0 to 6229 Do Begin
pCodeNumberToC1C2(i, C1, C2);
if (C1 = iC1) and (C2 = iC2) Then Result := i;
End;
Result := cn;
End;
Let's
N = p * 790 + q
then
c1 = 48 + q div 10
c2 = 48 + q mod 10 + 10 * p
so
p = (c2-48) div 10
q = (c2-48) mod 10 + (c1-48) * 10
test:
var
c1, c2: Byte;
n, p, q, t: Word;
begin
for t := 0 to 6229 do begin
n := t;
pCodeNumberToC1C2(n, c1, c2);
p := (c2-48) div 10;
q := (c2-48) mod 10 + (c1-48) * 10;
n := 790*p+q;
if n <> t then
Memo1.Lines.Add('Failed at ' + IntToStr(t))
end;
Final:
function C1C2ToCodeNumber(C1, C2: Byte): Word;
begin
Result := ((C2 - 48) div 10) * 790 + ((C2 - 48) mod 10 + (C1 - 48) * 10);
end;
As an alternative to arithmetic you could consider a lookup table. At the cost of memory, this gives you better performance. The code looks like this:
const
CodeNumberTable: array [48..126, 48..127] of Word = (
.... code removed because of Sack Overflow post size limitation
);
const
MinC1 = low(CodeNumberTable);
MinC2 = high(CodeNumberTable);
MaxC1 = low(CodeNumberTable[MinC1]);
MaxC2 = high(CodeNumberTable[MinC1]);
type
EInvalidParameters = class(Exception);
function fC1C2ToCodeNumber(iC1, iC2: Byte): Word;
begin
if not InRange(iC1, MinC1, MaxC1) then
raise EInvalidParameters.CreateFmt(
'iC1 (%d) must be in the range %d to %d',
[iC1, MinC1, MaxC1]
);
if not InRange(iC2, MinC2, MaxC2) then
raise EInvalidParameters.CreateFmt(
'iC2 (%d) must be in the range %d to %d',
[iC2, MinC2, MaxC2]
);
Result := CodeNumberTable[iC1, iC2];
if Result=high(Word) then
raise EInvalidParameters.CreateFmt(
'CodeNumber not defined for iC1=%d, ic2=%d',
[iC1, iC2]
);
end;
I can supply the table via paste bin if you are interested.
Does anyone know where I could find code for the "Inverse Error Function?" Freepascal/Delphi would be preferable but C/C++ would be fine too.
The TMath/DMath library did not have it :(
Here's an implementation of erfinv(). Note that for it to work well, you also need a good implementation of erf().
function erfinv(const y: Double): Double;
//rational approx coefficients
const
a: array [0..3] of Double = ( 0.886226899, -1.645349621, 0.914624893, -0.140543331);
b: array [0..3] of Double = (-2.118377725, 1.442710462, -0.329097515, 0.012229801);
c: array [0..3] of Double = (-1.970840454, -1.624906493, 3.429567803, 1.641345311);
d: array [0..1] of Double = ( 3.543889200, 1.637067800);
const
y0 = 0.7;
var
x, z: Double;
begin
if not InRange(y, -1.0, 1.0) then begin
raise EInvalidArgument.Create('erfinv(y) argument out of range');
end;
if abs(y)=1.0 then begin
x := -y*Ln(0.0);
end else if y<-y0 then begin
z := sqrt(-Ln((1.0+y)/2.0));
x := -(((c[3]*z+c[2])*z+c[1])*z+c[0])/((d[1]*z+d[0])*z+1.0);
end else begin
if y<y0 then begin
z := y*y;
x := y*(((a[3]*z+a[2])*z+a[1])*z+a[0])/((((b[3]*z+b[3])*z+b[1])*z+b[0])*z+1.0);
end else begin
z := sqrt(-Ln((1.0-y)/2.0));
x := (((c[3]*z+c[2])*z+c[1])*z+c[0])/((d[1]*z+d[0])*z+1.0);
end;
//polish x to full accuracy
x := x - (erf(x) - y) / (2.0/sqrt(pi) * exp(-x*x));
x := x - (erf(x) - y) / (2.0/sqrt(pi) * exp(-x*x));
end;
Result := x;
end;
If you haven't got an implementation of erf() then you can try this one converted to Pascal from Numerical Recipes. It's not accurate to double precision though.
function erfc(const x: Double): Double;
var
t,z,ans: Double;
begin
z := abs(x);
t := 1.0/(1.0+0.5*z);
ans := t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+t*(0.09678418+
t*(-0.18628806+t*(0.27886807+t*(-1.13520398+t*(1.48851587+
t*(-0.82215223+t*0.17087277)))))))));
if x>=0.0 then begin
Result := ans;
end else begin
Result := 2.0-ans;
end;
end;
function erf(const x: Double): Double;
begin
Result := 1.0-erfc(x);
end;
Pascal Programs for Scientists and Engineers has the gaussian Error function (erf) and its complement erfc=(1-errf), but not the Inverse of the Error function. Obviously, you don't just take 1/ErrF. The inverse means x = erfinv(y) satisfies y = erf(x).
http://infohost.nmt.edu/~armiller/pascal.htm
Error function and its complement, are shown in this listing.
Again, the definition of Error Function Complement is 1-ErrF, not ErrF^-1, but this has got to be getting you close:
http://infohost.nmt.edu/~es421/pascal/list11-3.pas
I found this interesting implementation (language unknown, I'm guessing it's matlab). maybe it and its coefficients can help you:
http://w3eos.whoi.edu/12.747/mfiles/lect07/erfinv.m
Another PDF here:
http://people.maths.ox.ac.uk/~gilesm/files/gems_erfinv.pdf
Relevant snippet:
Table 1: Pseudo-code to compute y = erfinv(x) , with p1(t)..p6(t) representing
a 1st through 6th polynomial function of t :
a = |x|
if a > 0.9375 then
t = sqrt( log(a) )
y = p1(t) / p2(t)
else if a > 0.75 then
y = p3(a) / p4(a)
else
y = p5(a) / p6(a)
end if
if x < 0 then
y = −y
end if
Apparently the library code functions by approximation, it's less work. Sometimes the approximations are to less than 6 decimal places accuracy, I read.
Fortran code that many people use for a reference, is here, it cites "Rational Chebyshev approximations for the error function" by W. J. Cody, Math. Comp., 1969, PP. 631-638.:
The math is pretty complex, but there's a decent approximation described here (warning: PDF) that includes Maple code. Unfortunately it involves a "solve for x" step that might make it useless to you.
Boost seems to have it as error_inv so look at the code.
I've used this, which I believe is reasonably accurate and quick (usually 2 iterations of the loop), but of course caveat emptor. NormalX assumes that 0<=Q<=1, and would likely give silly answers if that assumption doesn't hold.
/* return P(N>X) for normal N */
double NormalQ( double x)
{ return 0.5*erfc( x/sqrt(2.0));
}
#define NORX_C0 2.8650422353e+00
#define NORX_C1 3.3271545598e+00
#define NORX_C2 2.7147548996e-01
#define NORX_D1 2.8716448975e+00
#define NORX_D2 1.1690926940e+00
#define NORX_D3 4.7994444496e-02
/* return X such that P(N>X) = Q for normal N */
double NormalX( double Q)
{
double eps = 1e-12;
int signum = Q < 0.5;
double QF = signum ? Q : (1.0-Q);
double T = sqrt( -2.0*log(QF));
double X = T - ((NORX_C2*T + NORX_C1)*T + NORX_C0)
/(((NORX_D3*T + NORX_D2)*T + NORX_D1)*T + 1.0);
double SPI2 = sqrt( 2.0 * M_PI);
int i;
/* newton's method */
for( i=0; i<10; ++i)
{
double dX = (NormalQ(X) - QF)*exp(0.5*X*X)*SPI2;
X += dX;
if ( fabs( dX) < eps)
{ break;
}
}
return signum ? X : -X;
}
function erf(const x: extended): extended;
var
n: integer;
z: extended;
begin
Result := x;
z := x;
n := 0;
repeat
inc(n);
z := -z * x * x * (2 * n - 1) / ((2 * n + 1) * n);
Result := Result + z;
until abs(z) < 1E-20;
Result := Result * 2 / sqrt(pi);
end;
function erfinv(const x: extended): extended;
var
n: integer;
z: extended;
begin
Result := 0;
n := 0;
repeat
inc(n);
z := (erf(Result) - x) * sqrt(pi) / (2 * exp(-Result * Result));
Result := Result - z;
until (n = 100) or (abs(z) < 1E-20);
if abs(z) < 1E-20 then
n := -20
else
n := Floor(Log10(abs(z))) + 1;
Result := RoundTo(Result, n);
end;
Here is what I have from spe. To me it looks like they tried to speed it up by dragging all functions into one big polynomal. Keep in mind this is code from the 386 era
// Extract from package Numlib in the Free Pascal sources (http://www.freepascal.org)
// LGPL-with-static-linking-exception, see original source for exact license.
// Note this is usually compiled in TP mode, not in Delphi mode.
Const highestElement = 20000000;
Type ArbFloat = double; // can be extended too.
ArbInt = Longint;
arfloat0 = array[0..highestelement] of ArbFloat;
function spesgn(x: ArbFloat): ArbInt;
begin
if x<0
then
spesgn:=-1
else
if x=0
then
spesgn:=0
else
spesgn:=1
end; {spesgn}
function spepol(x: ArbFloat; var a: ArbFloat; n: ArbInt): ArbFloat;
var pa : ^arfloat0;
i : ArbInt;
polx : ArbFloat;
begin
pa:=#a;
polx:=0;
for i:=n downto 0 do
polx:=polx*x+pa^[i];
spepol:=polx
end {spepol};
function speerf(x : ArbFloat) : ArbFloat;
const
xup = 6.25;
sqrtpi = 1.7724538509055160;
c : array[1..18] of ArbFloat =
( 1.9449071068178803e0, 4.20186582324414e-2, -1.86866103976769e-2,
5.1281061839107e-3, -1.0683107461726e-3, 1.744737872522e-4,
-2.15642065714e-5, 1.7282657974e-6, -2.00479241e-8,
-1.64782105e-8, 2.0008475e-9, 2.57716e-11,
-3.06343e-11, 1.9158e-12, 3.703e-13,
-5.43e-14, -4.0e-15, 1.2e-15);
d : array[1..17] of ArbFloat =
( 1.4831105640848036e0, -3.010710733865950e-1, 6.89948306898316e-2,
-1.39162712647222e-2, 2.4207995224335e-3, -3.658639685849e-4,
4.86209844323e-5, -5.7492565580e-6, 6.113243578e-7,
-5.89910153e-8, 5.2070091e-9, -4.232976e-10,
3.18811e-11, -2.2361e-12, 1.467e-13,
-9.0e-15, 5.0e-16);
var t, s, s1, s2, x2: ArbFloat;
bovc, bovd, j: ArbInt;
begin
bovc:=sizeof(c) div sizeof(ArbFloat);
bovd:=sizeof(d) div sizeof(ArbFloat);
t:=abs(x);
if t <= 2
then
begin
x2:=sqr(x)-2;
s1:=d[bovd]; s2:=0; j:=bovd-1;
s:=x2*s1-s2+d[j];
while j > 1 do
begin
s2:=s1; s1:=s; j:=j-1;
s:=x2*s1-s2+d[j]
end;
speerf:=(s-s2)*x/2
end
else
if t < xup
then
begin
x2:=2-20/(t+3);
s1:=c[bovc]; s2:=0; j:=bovc-1;
s:=x2*s1-s2+c[j];
while j > 1 do
begin
s2:=s1; s1:=s; j:=j-1;
s:=x2*s1-s2+c[j]
end;
x2:=((s-s2)/(2*t))*exp(-sqr(x))/sqrtpi;
speerf:=(1-x2)*spesgn(x)
end
else
speerf:=spesgn(x)
end; {speerf}
function spemax(a, b: ArbFloat): ArbFloat;
begin
if a>b
then
spemax:=a
else
spemax:=b
end; {spemax}
function speefc(x : ArbFloat) : ArbFloat;
const
xlow = -6.25;
xhigh = 27.28;
c : array[0..22] of ArbFloat =
( 1.455897212750385e-1, -2.734219314954260e-1,
2.260080669166197e-1, -1.635718955239687e-1,
1.026043120322792e-1, -5.480232669380236e-2,
2.414322397093253e-2, -8.220621168415435e-3,
1.802962431316418e-3, -2.553523453642242e-5,
-1.524627476123466e-4, 4.789838226695987e-5,
3.584014089915968e-6, -6.182369348098529e-6,
7.478317101785790e-7, 6.575825478226343e-7,
-1.822565715362025e-7, -7.043998994397452e-8,
3.026547320064576e-8, 7.532536116142436e-9,
-4.066088879757269e-9, -5.718639670776992e-10,
3.328130055126039e-10);
var t, s : ArbFloat;
begin
if x <= xlow
then
speefc:=2
else
if x >= xhigh
then
speefc:=0
else
begin
t:=1-7.5/(abs(x)+3.75);
s:=exp(-x*x)*spepol(t, c[0], sizeof(c) div sizeof(ArbFloat) - 1);
if x < 0
then
speefc:=2-s
else
speefc:=s
end
end {speefc};