You've already forked lazarus-ccr
LazStats: Add tests.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7925 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
72
applications/lazstats/tests/gammaln_test/Project1.lpi
Normal file
72
applications/lazstats/tests/gammaln_test/Project1.lpi
Normal file
@@ -0,0 +1,72 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="Project1"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="TAChartLazarusPkg"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<PackageName Value="LMath"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="Project1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="Project1"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\..\source\units"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf2Set"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
64
applications/lazstats/tests/gammaln_test/Project1.pas
Normal file
64
applications/lazstats/tests/gammaln_test/Project1.pas
Normal file
@@ -0,0 +1,64 @@
|
||||
program Project1;
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
spe,
|
||||
MathUnit;
|
||||
|
||||
// Numerical recipes
|
||||
function GammaLn(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;
|
||||
|
||||
const
|
||||
xmin = 1e-3;
|
||||
xmax = 5.0;
|
||||
|
||||
procedure Test;
|
||||
var
|
||||
i: Integer;
|
||||
x, y_lazStats, y_numlib, y_numrecip: Double;
|
||||
begin
|
||||
WriteLn('x':20, 'y(lazstats)':20, 'y(numlib)':20, 'y(Num.Recipies)':20);
|
||||
x := xmin;
|
||||
while (x <= xmax) do begin
|
||||
y_numlib := 1.0 - spelga(x);
|
||||
y_lazstats := MathUnit.gammaln(x);
|
||||
y_numrecip := gammaln(x);
|
||||
|
||||
WriteLn(x:20:6, y_lazstats:20:5, y_numlib:20:5, y_numrecip:20:5);
|
||||
x := x*1.25
|
||||
// x := x + dx;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
WriteLn('GammaLn function');
|
||||
WriteLn;
|
||||
Test;
|
||||
ReadLn;
|
||||
end.
|
||||
|
Reference in New Issue
Block a user