You've already forked lazarus-ccr
67 lines
1.5 KiB
ObjectPascal
67 lines
1.5 KiB
ObjectPascal
|
program Project1;
|
||
|
|
|
||
|
|
uses
|
||
|
|
SysUtils,
|
||
|
|
spe,
|
||
|
|
MathUnit;
|
||
|
|
|
||
|
|
|
||
|
|
const
|
||
|
|
w = 15;
|
||
|
|
// Numerical recipes
|
||
|
|
|
||
|
|
function gammln(x: double): Double;
|
||
|
|
{ gibt den Log der vollständigen Gamma-Funktion zurück (x>0).
|
||
|
|
Gamma(x) = integral ( t^(x-1) * exp(-t) dt ) (von 0 bis Unendlich)
|
||
|
|
(Log, um Floating Point Underflow zu vermeiden). }
|
||
|
|
const
|
||
|
|
stp = 2.50662827465;
|
||
|
|
var
|
||
|
|
xx,tmp,ser : extended;
|
||
|
|
begin
|
||
|
|
if x<=0 then
|
||
|
|
raise Exception.Create('Argument für GammaLn ist negativ.');
|
||
|
|
if (x>1) then begin
|
||
|
|
xx := x - 1.0;
|
||
|
|
tmp := xx + 5.5;
|
||
|
|
tmp := (xx+0.5) * ln(tmp) - tmp;
|
||
|
|
ser := 1.0 + 76.18009173 /(xx+1.0) - 86.50532033/(xx+2.0)
|
||
|
|
+ 24.01409822 /(xx+3.0) - 1.231739516/(xx+4.0)
|
||
|
|
+ 0.120858003E-2/(xx+5.0) - 0.536382E-5/(xx+6.0);
|
||
|
|
result := tmp + ln(stp*ser);
|
||
|
|
end else
|
||
|
|
if (x<1) then
|
||
|
|
result := GammaLn(x+1.0) - ln(x)
|
||
|
|
else
|
||
|
|
if (x=1) then
|
||
|
|
result := 0.0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function Beta(a,b: Double) : Double;
|
||
|
|
begin
|
||
|
|
Result := exp(gammln(a) + gammln(b) - gammln(a+b));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure Test(a, b: Double);
|
||
|
|
var
|
||
|
|
y_lazStats, y_numlib, y_numrecip: Double;
|
||
|
|
begin
|
||
|
|
y_numlib := spe.beta(a, b);
|
||
|
|
y_lazstats := mathunit.beta(a, b);
|
||
|
|
y_numrecip := beta(a, b);
|
||
|
|
WriteLn(a:w:5, b:w:5, y_lazstats:w:5, y_numlib:w:5, y_numrecip:w:5);
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
WriteLn('Beta function');
|
||
|
|
WriteLn;
|
||
|
|
WriteLn('a':w, 'b':w, 'y(lazstats)':w, 'y(numlib)':w, 'y(Num.Recip)':w);
|
||
|
|
Test(0.5, 0.5);
|
||
|
|
Test(1.1, 2.3);
|
||
|
|
Test(2.3, 1.1);
|
||
|
|
Test(2.9, 0.1);
|
||
|
|
Test(5.1, 2.5);
|
||
|
|
ReadLn;
|
||
|
|
end.
|
||
|
|
|