📄 testbdssunit.pas
字号:
begin
if N=3 then
begin
Split2Errors := Split2Errors or (AbsReal(CVRMS-Sqrt((2*0+2*0+2*0.25)/6))>100*MachineEpsilon);
end
else
begin
Split2Errors := Split2Errors or (AbsReal(CVRMS)>100*MachineEpsilon);
end;
end;
end;
Inc(N);
end;
//
// special tests
//
N := 10;
SetLength(A, N-1+1);
SetLength(C, N-1+1);
SetLength(TieBuf, N+1);
SetLength(CntBuf, 2*3-1+1);
I:=0;
while I<=N-1 do
begin
A[I] := I;
if I<=N-3 then
begin
C[I] := 0;
end
else
begin
C[I] := I-(N-3);
end;
Inc(I);
end;
DSOptimalSplit2Fast(A, C, TieBuf, CntBuf, N, 3, 0.00, Info, Threshold, RMS, CVRMS);
if Info<>1 then
begin
Split2Errors := True;
end
else
begin
Split2Errors := Split2Errors or (AbsReal(Threshold-(N-2.5))>100*MachineEpsilon);
Split2Errors := Split2Errors or (AbsReal(RMS-Sqrt((0.25+0.25+0.25+0.25)/(3*N)))>100*MachineEpsilon);
Split2Errors := Split2Errors or (AbsReal(CVRMS-Sqrt((1+1+1+1)/(3*N)))>100*MachineEpsilon);
end;
//
// Optimal split-K
//
//
// General tests for different N's
//
N:=1;
while N<=MaxNQ do
begin
SetLength(A, N-1+1);
SetLength(C, N-1+1);
//
// one-tie test
//
if N mod 2=0 then
begin
I:=0;
while I<=N-1 do
begin
A[I] := Pass;
C[I] := I mod 2;
Inc(I);
end;
DSOptimalSplitK(A, C, N, 2, 2+RandomInteger(5), Info, Thresholds, NI, CVE);
if Info<>-3 then
begin
OptimalSplitKErrors := True;
Inc(N);
Continue;
end;
end;
//
// two-tie test
//
//
// test #1
//
if N>1 then
begin
C0 := 0;
C1 := 0;
I:=0;
while I<=N-1 do
begin
A[I] := I div ((N+1) div 2);
C[I] := I div ((N+1) div 2);
if C[I]=0 then
begin
C0 := C0+1;
end;
if C[I]=1 then
begin
C1 := C1+1;
end;
Inc(I);
end;
DSOptimalSplitK(A, C, N, 2, 2+RandomInteger(5), Info, Thresholds, NI, CVE);
if Info<>1 then
begin
OptimalSplitKErrors := True;
Inc(N);
Continue;
end;
OptimalSplitKErrors := OptimalSplitKErrors or (NI<>2);
OptimalSplitKErrors := OptimalSplitKErrors or (AbsReal(Thresholds[0]-0.5)>100*MachineEpsilon);
OptimalSplitKErrors := OptimalSplitKErrors or (AbsReal(CVE-(-C0*Ln(C0/(C0+1))-C1*Ln(C1/(C1+1))))>100*MachineEpsilon);
end;
//
// test #2
//
if N>2 then
begin
C0 := 1+RandomInteger(N-1);
C1 := N-C0;
I:=0;
while I<=N-1 do
begin
if I<C0 then
begin
A[I] := 0;
C[I] := 0;
end
else
begin
A[I] := 1;
C[I] := 1;
end;
Inc(I);
end;
DSOptimalSplitK(A, C, N, 2, 2+RandomInteger(5), Info, Thresholds, NI, CVE);
if Info<>1 then
begin
OptimalSplitKErrors := True;
Inc(N);
Continue;
end;
OptimalSplitKErrors := OptimalSplitKErrors or (NI<>2);
OptimalSplitKErrors := OptimalSplitKErrors or (AbsReal(Thresholds[0]-0.5)>100*MachineEpsilon);
OptimalSplitKErrors := OptimalSplitKErrors or (AbsReal(CVE-(-C0*Ln(C0/(C0+1))-C1*Ln(C1/(C1+1))))>100*MachineEpsilon);
end;
//
// multi-tie test
//
if N>=16 then
begin
//
// Multi-tie test.
//
// First NC-1 ties have C0 entries, remaining NC-th tie
// have C1 entries.
//
NC := Round(Sqrt(N));
C0 := N div NC;
C1 := N-C0*(NC-1);
I:=0;
while I<=NC-2 do
begin
J:=C0*I;
while J<=C0*(I+1)-1 do
begin
A[J] := J;
C[J] := I;
Inc(J);
end;
Inc(I);
end;
J:=C0*(NC-1);
while J<=N-1 do
begin
A[J] := J;
C[J] := NC-1;
Inc(J);
end;
DSOptimalSplitK(A, C, N, NC, NC+RandomInteger(NC), Info, Thresholds, NI, CVE);
if Info<>1 then
begin
OptimalSplitKErrors := True;
Inc(N);
Continue;
end;
OptimalSplitKErrors := OptimalSplitKErrors or (NI<>NC);
if NI=NC then
begin
I:=0;
while I<=NC-2 do
begin
OptimalSplitKErrors := OptimalSplitKErrors or (AbsReal(Thresholds[I]-(C0*(I+1)-1+0.5))>100*MachineEpsilon);
Inc(I);
end;
CVR := -((NC-1)*C0*Ln(C0/(C0+NC-1))+C1*Ln(C1/(C1+NC-1)));
OptimalSplitKErrors := OptimalSplitKErrors or (AbsReal(CVE-CVR)>100*MachineEpsilon);
end;
end;
Inc(N);
end;
//
// Non-optimal split-K
//
//
// General tests for different N's
//
N:=1;
while N<=MaxNQ do
begin
SetLength(A, N-1+1);
SetLength(C, N-1+1);
//
// one-tie test
//
if N mod 2=0 then
begin
I:=0;
while I<=N-1 do
begin
A[I] := Pass;
C[I] := I mod 2;
Inc(I);
end;
DSSplitK(A, C, N, 2, 2+RandomInteger(5), Info, Thresholds, NI, CVE);
if Info<>-3 then
begin
SplitKErrors := True;
Inc(N);
Continue;
end;
end;
//
// two-tie test
//
//
// test #1
//
if N>1 then
begin
C0 := 0;
C1 := 0;
I:=0;
while I<=N-1 do
begin
A[I] := I div ((N+1) div 2);
C[I] := I div ((N+1) div 2);
if C[I]=0 then
begin
C0 := C0+1;
end;
if C[I]=1 then
begin
C1 := C1+1;
end;
Inc(I);
end;
DSSplitK(A, C, N, 2, 2+RandomInteger(5), Info, Thresholds, NI, CVE);
if Info<>1 then
begin
SplitKErrors := True;
Inc(N);
Continue;
end;
SplitKErrors := SplitKErrors or (NI<>2);
if NI=2 then
begin
SplitKErrors := SplitKErrors or (AbsReal(Thresholds[0]-0.5)>100*MachineEpsilon);
SplitKErrors := SplitKErrors or (AbsReal(CVE-(-C0*Ln(C0/(C0+1))-C1*Ln(C1/(C1+1))))>100*MachineEpsilon);
end;
end;
//
// test #2
//
if N>2 then
begin
C0 := 1+RandomInteger(N-1);
C1 := N-C0;
I:=0;
while I<=N-1 do
begin
if I<C0 then
begin
A[I] := 0;
C[I] := 0;
end
else
begin
A[I] := 1;
C[I] := 1;
end;
Inc(I);
end;
DSSplitK(A, C, N, 2, 2+RandomInteger(5), Info, Thresholds, NI, CVE);
if Info<>1 then
begin
SplitKErrors := True;
Inc(N);
Continue;
end;
SplitKErrors := SplitKErrors or (NI<>2);
if NI=2 then
begin
SplitKErrors := SplitKErrors or (AbsReal(Thresholds[0]-0.5)>100*MachineEpsilon);
SplitKErrors := SplitKErrors or (AbsReal(CVE-(-C0*Ln(C0/(C0+1))-C1*Ln(C1/(C1+1))))>100*MachineEpsilon);
end;
end;
//
// multi-tie test
//
C0:=4;
while C0<=N do
begin
if (N mod C0=0) and (N div C0<=C0) and (N div C0>1) then
begin
NC := N div C0;
I:=0;
while I<=NC-1 do
begin
J:=C0*I;
while J<=C0*(I+1)-1 do
begin
A[J] := J;
C[J] := I;
Inc(J);
end;
Inc(I);
end;
DSSplitK(A, C, N, NC, NC+RandomInteger(NC), Info, Thresholds, NI, CVE);
if Info<>1 then
begin
SplitKErrors := True;
Inc(C0);
Continue;
end;
SplitKErrors := SplitKErrors or (NI<>NC);
if NI=NC then
begin
I:=0;
while I<=NC-2 do
begin
SplitKErrors := SplitKErrors or (AbsReal(Thresholds[I]-(C0*(I+1)-1+0.5))>100*MachineEpsilon);
Inc(I);
end;
CVR := -NC*C0*Ln(C0/(C0+NC-1));
SplitKErrors := SplitKErrors or (AbsReal(CVE-CVR)>100*MachineEpsilon);
end;
end;
Inc(C0);
end;
Inc(N);
end;
//
// report
//
WasErrors := TiesErrors or Split2Errors or OptimalSplitKErrors or SplitKErrors;
if not Silent then
begin
Write(Format('TESTING BASIC DATASET SUBROUTINES'#13#10'',[]));
Write(Format('TIES: ',[]));
if not TiesErrors then
begin
Write(Format('OK'#13#10'',[]));
end
else
begin
Write(Format('FAILED'#13#10'',[]));
end;
Write(Format('SPLIT-2: ',[]));
if not Split2Errors then
begin
Write(Format('OK'#13#10'',[]));
end
else
begin
Write(Format('FAILED'#13#10'',[]));
end;
Write(Format('OPTIMAL SPLIT-K: ',[]));
if not OptimalSplitKErrors then
begin
Write(Format('OK'#13#10'',[]));
end
else
begin
Write(Format('FAILED'#13#10'',[]));
end;
Write(Format('SPLIT-K: ',[]));
if not SplitKErrors then
begin
Write(Format('OK'#13#10'',[]));
end
else
begin
Write(Format('FAILED'#13#10'',[]));
end;
if WasErrors then
begin
Write(Format('TEST FAILED'#13#10'',[]));
end
else
begin
Write(Format('TEST PASSED'#13#10'',[]));
end;
Write(Format(''#13#10''#13#10'',[]));
end;
Result := not WasErrors;
end;
(*************************************************************************
Unsets 2D array.
*************************************************************************)
procedure Unset2D(var A : TComplex2DArray);
begin
SetLength(A, 0+1, 0+1);
A[0,0] := C_Complex(2*RandomReal-1);
end;
(*************************************************************************
Unsets 1D array.
*************************************************************************)
procedure Unset1D(var A : TReal1DArray);
begin
SetLength(A, 0+1);
A[0] := 2*RandomReal-1;
end;
(*************************************************************************
Unsets 1D array.
*************************************************************************)
procedure Unset1DI(var A : TInteger1DArray);
begin
SetLength(A, 0+1);
A[0] := RandomInteger(3)-1;
end;
procedure TestSortResults(const ASorted : TReal1DArray;
const P1 : TInteger1DArray;
const P2 : TInteger1DArray;
const AOriginal : TReal1DArray;
N : Integer;
var WasErrors : Boolean);
var
I : Integer;
A2 : TReal1DArray;
T : Double;
F : TInteger1DArray;
begin
SetLength(A2, N-1+1);
SetLength(F, N-1+1);
//
// is set ordered?
//
I:=0;
while I<=N-2 do
begin
WasErrors := WasErrors or (ASorted[I]>ASorted[I+1]);
Inc(I);
end;
//
// P1 correctness
//
I:=0;
while I<=N-1 do
begin
WasErrors := WasErrors or (ASorted[I]<>AOriginal[P1[I]]);
Inc(I);
end;
I:=0;
while I<=N-1 do
begin
F[I] := 0;
Inc(I);
end;
I:=0;
while I<=N-1 do
begin
F[P1[I]] := F[P1[I]]+1;
Inc(I);
end;
I:=0;
while I<=N-1 do
begin
WasErrors := WasErrors or (F[I]<>1);
Inc(I);
end;
//
// P2 correctness
//
I:=0;
while I<=N-1 do
begin
A2[I] := AOriginal[I];
Inc(I);
end;
I:=0;
while I<=N-1 do
begin
if P2[I]<>I then
begin
T := A2[I];
A2[I] := A2[P2[I]];
A2[P2[I]] := T;
end;
Inc(I);
end;
I:=0;
while I<=N-1 do
begin
WasErrors := WasErrors or (ASorted[I]<>A2[I]);
Inc(I);
end;
end;
(*************************************************************************
Silent unit test
*************************************************************************)
function testbdssunit_test_silent():Boolean;
begin
Result := TestBDSS(True);
end;
(*************************************************************************
Unit test
*************************************************************************)
function testbdssunit_test():Boolean;
begin
Result := TestBDSS(False);
end;
end.⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -