unit tsrandom;
inteface
type
{ A threadsafe implementation of Free Pascal's random number generator.
The Free Pascal default Random is not thread safe.
This algorithm is fully compatible will Free Pascal's Random.
It is an implementation of a Mersenne Twister.
See:https://en.wikipedia.org/wiki/Mersenne_Twister
This class only guarantees a repeatable series of random values
within the same thread. Every thread has it's own Random and Randseed.
Exported data, however, can be repeated provided the Randseed is known.
Every Randseed needs to be initialized on a per thread basis.}
{ TThreadSafeRandom }
TThreadSafeRandom = class sealed
strict private
class function GetSeed: Cardinal; inline;static;
class procedure SetSeed(AValue: Cardinal);inline; static;
class procedure Initialize(const ASeed:Cardinal);inline;static;
class procedure Twist;inline;static;
class function IM:Cardinal;inline;static;
class constructor create;
public
class procedure Randomize;inline;static;
class function Random: extended; overload;static;inline;
class function Random(range:longint):longint;overload;static;inline;
class function Random(range:int64):int64;overload;static;inline;
class property RandSeed:Cardinal Read GetSeed write SetSeed;
end;
TsRand = type TThreadSafeRandom;
implementation
const
// Define MT19937 constants (32-bit RNG)
N = 624;M = 397;R = 31;A = $9908B0DF;F = 1812433253;
U = 11;S = 7;B = $9D2C5680;T = 15;C = $EFC60000;L = 18;
MASK_LOWER = QWORD(1) << R - 1;
MASK_UPPER = QWORD(1) << R;
// conversion constants. Converts IM output from Cardinal to Float.
CONVERT_UNSIGNED = Extended (1.0/int64(1 shl 32)); // 0..1
CONVERT_SIGNED = Extended (2.0/int64(1 shl 32)); // -1..1
Threadvar
MtRandSeed:Cardinal;
MtOldRandSeed:Cardinal;
Index:Cardinal;
mt:array[0..N-1] of dword;
{ TThreadSafeRandom }
class function TThreadSafeRandom.GetSeed: Cardinal;
begin
Result := mtRandSeed;
end;
class procedure TThreadSafeRandom.SetSeed(AValue: Cardinal);
begin
mtRandSeed := AValue;
Initialize(mtRandseed);
end;
class procedure TThreadSafeRandom.Initialize(const ASeed: Cardinal);
var
i:dword;
begin
mt[0] := Aseed;
for i := 1 to pred(N) do
mt[i] := F * (mt[i - 1] xor (mt[i - 1] >> 30)) + i;
index := N;
end;
class procedure TThreadSafeRandom.Twist;inline;static;
var
i:integer;
begin
for i:=0 to N-M-1 do
mt[i]:=mt[i+M] xor {twist} (((mt[i] and MASK_UPPER) or
(mt[i+1] and MASK_LOWER)) shr 1)xor(dword(-(mt[i+1] and 1)) and A);
for i:=N-M to N-2 do
mt[i]:=mt[i+(M-N)]xor{twist}(((mt[i] and MASK_UPPER) or
(mt[i+1] and MASK_LOWER)) shr 1)xor(dword(-(mt[i+1] and 1)) and A);
mt[N-1]:=mt[M-1] xor {twist} (((mt[n-1] and MASK_UPPER) or (mt[0] and
MASK_LOWER)) shr 1)xor(dword(-(mt[0] and 1)) and A);
index:=0;
end;
class constructor TThreadSafeRandom.create;
begin
initialize(0);
mtOldRandSeed := 0;
end;
class procedure TThreadSafeRandom.Randomize;
begin
// Hm. Not ideal...
system.Randomize;
// assumes the Randseed is atomic for read
mtrandseed := RandSeed;
end;
class function TThreadSafeRandom.Random: extended;overload;inline;static;
begin
Result := IM * CONVERT_UNSIGNED
end;
class function TThreadSafeRandom.Random(range: longint): longint;
begin
if Range < 0 then inc(Range);
Result := IM * Range shr 32;
end;
class function TThreadSafeRandom.Random(range: int64): int64;
begin
Result:=IM;
Result:=Result or ((qword(IM) shl 32) and high(int64));
if Range<>0 then
Result := Result mod range
else
Result := 0;
end;
class function TThreadSafeRandom.IM: Cardinal;inline;static;
var
i:integer;
begin
i := index;
if (index >= N) or (mtRandSeed<>mtOldRandSeed) then
begin
Twist;
mtRandSeed:=not(mtRandSeed);
mtOldRandSeed:=mtRandSeed;
i := index;
end;
Result := mt[i];
index := i + 1;
Result := Result xor (mt[i] >> U);
Result := Result xor (Result << S) and B;
Result := Result xor (Result << T) and C;
Result := Result xor (Result >> L);
end;
end.