Browse Source

+ test for Math.RandG based on demo provided by Rika for mr 692

florian 1 year ago
parent
commit
97a5ec0ff4
1 changed files with 68 additions and 0 deletions
  1. 68 0
      tests/test/units/math/trandg.pp

+ 68 - 0
tests/test/units/math/trandg.pp

@@ -0,0 +1,68 @@
+{$mode objfpc} {$longstrings on} {$coperators on} {$zerobasedstrings on}
+uses
+	SysUtils, Math;
+
+type
+	RandgFunc = function(mean,stddev : float) : float;
+
+procedure Demo(const name: string; randgf: RandgFunc);
+const
+	Mean = 5;
+	StdDev = 1.5;
+	HistogramMin = 0;
+	HistogramMax = 10;
+	NHistogramBuckets = 40;
+	NRows = 12;
+	NSamples = 100 * 1000 * 1000;
+var
+	hist: array of uint32;
+	iSample, nOutOfRange, maxInBucket: uint32;
+	iHist, y: SizeInt;
+	row, msg, newMsg: string;
+	time: double;
+begin
+	RandSeed := 1;
+	nOutOfRange := 0;
+	maxInBucket := 0;
+	SetLength(hist, NHistogramBuckets);
+	msg := '';
+	time := Now;
+	for iSample := 0 to NSamples - 1 do
+	begin
+		if iSample and (1 shl 21 - 1) = 0 then
+		begin
+			WriteStr(newMsg, name, ': ', iSample / NSamples * 100:0:1, '%');
+			write(stderr, #13, StringOfChar(' ', length(msg)), #13, newMsg);
+			msg := newMsg;
+		end;
+		iHist := round(EnsureRange((randgf(Mean, StdDev) - HistogramMin) / (HistogramMax - HistogramMin) * NHistogramBuckets, -1, NHistogramBuckets));
+		if (iHist >= 0) and (iHist < NHistogramBuckets) then
+		begin
+			hist[iHist] += 1;
+			if hist[iHist] > maxInBucket then
+				maxInBucket := hist[iHist];
+		end else
+			nOutOfRange += 1;
+	end;
+	time := (Now - time) * SecsPerDay;
+	write(stderr, #13, StringOfChar(' ', length(msg)), #13);
+
+	SetLength(row, NHistogramBuckets);
+	for y := 0 to NRows - 1 do
+	begin
+		for iHist := 0 to NHistogramBuckets - 1 do
+			if (y = 0) and (iHist < length(name)) then
+				pChar(pointer(row))[iHist] := name[iHist]
+			else
+				pChar(pointer(row))[iHist] := pChar(' #')[ord(hist[iHist] / maxInBucket >= (NRows - y - 0.5) / NRows)];
+		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
+	  halt(1);
+end;
+
+begin
+	Demo('Math.RandG', @math.randg);
+end.