paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 14:47:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

Faster trandg.pp.

Browse Source
This commit is contained in:
Rika Ichinose 2024-07-10 21:05:26 +03:00 committed by FPK
parent e082fe9752
commit 691dc59a2a
1 changed files with 48 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
tests/test/units/math/trandg.pp
View File

@ -15,17 +15,36 @@ const
StdDev = 1.5;
HistogramMin = 0;
HistogramMax = 10;
NHistogramBuckets = 40;
NRows = 12;
NHistogramBuckets = 80;
NRows = 16;
{$ifdef SMALL_TEST}
NSamples = 100 * 1000;
{$else SMALL_TEST}
NSamples = 100 * 1000 * 1000;
NSamples = 1 * 1000 * 1000;
{$endif SMALL_TEST}
Perfect: array[0 .. NRows - 1, 0 .. NHistogramBuckets - 1] of char =
(
' ####### ',
' ########### ',
' ############# ',
' ################# ',
' ################### ',
' ####################### ',
' ######################### ',
' ########################### ',
' ############################# ',
' ################################# ',
' ################################### ',
' ####################################### ',
' ######################################### ',
' ############################################### ',
' ##################################################### ',
' ############################################################### '
);
var
hist: array of uint32;
iSample, nOutOfRange, maxInBucket: uint32;
iHist, y: SizeInt;
iHist, y, imperfections: SizeInt;
row, msg, newMsg: string;
time: double;
begin
@ -59,6 +78,7 @@ begin
time := (Now - time) * SecsPerDay;
write(stderr, #13, StringOfChar(' ', length(msg)), #13);
imperfections := 0;
SetLength(row, NHistogramBuckets);
for y := 0 to NRows - 1 do
begin
@ -66,12 +86,35 @@ begin
if (y = 0) and (iHist < length(name)) then
pChar(pointer(row))[iHist] := name[iHist]
else
begin
pChar(pointer(row))[iHist] := pChar(' #')[ord(hist[iHist] / maxInBucket >= (NRows - y - 0.5) / NRows)];
if row[iHist] <> Perfect[y, iHist] then
if (y > 0) and (y + 1 < NRows) and (row[iHist] <> Perfect[y - 1, iHist]) and (row[iHist] <> Perfect[y + 1, iHist])
{$ifdef SMALL_TEST}
and
(
// Allow 2-storey imperfections for 25 columns in the middle.
(abs(iHist - round((Mean - HistogramMin) / (HistogramMax - HistogramMin) * NHistogramBuckets)) > 12) or
(y > 1) and (y + 2 < NRows) and (row[iHist] <> Perfect[y - 2, iHist]) and (row[iHist] <> Perfect[y + 2, iHist])
)
{$endif}
then
begin
pChar(pointer(row))[iHist] := '!';
imperfections := High(imperfections) div 2;
end else
begin
pChar(pointer(row))[iHist] := '*';
imperfections += 1;
end;
end;
writeln(row);
end;
writeln('Out of range: ', nOutOfRange, ' / ', NSamples, ' (', nOutOfRange / nSamples * 100:0:1, '%).', LineEnding,
'Took ', time:0:1, ' s.', LineEnding);
if nOutOfRange / nSamples>0.001 then
if nOutOfRange / nSamples>0.0015 then
halt(1);
if imperfections > {$ifdef SMALL_TEST} 40 {$else} 16 {$endif} then
halt(1);
end;