MathgeomGLS

1
unit Velthuis.RandomNumbers;
2

3
interface
4

5
type
6
  IRandom = interface
7
    function Next: Integer; overload;
8
    function Next(MaxValue: Integer): Integer; overload;
9
    function Next(MinValue, MaxValue: Integer): Integer; overload;
10
    function NextDouble: Double;
11
    procedure NextBytes(var Bytes: array of Byte);
12
    procedure SetSeed(Seed: Int64);
13
    function GetSeed: Int64;
14
    property Seed: Int64 read GetSeed write SetSeed;
15
  end;
16

17
  TRandom = class(TInterfacedObject, IRandom)
18
  private
19
    FSeed: Int64;       // Only 48 bits are used.
20
  public
21
    constructor Create(Seed: Int64 = 0);
22
    function Next: Integer; overload; virtual;
23
    function Next(MaxValue: Integer): Integer; overload;
24
    function Next(MinValue, MaxValue: Integer): Integer; overload;
25
    procedure NextBytes(var Bytes: array of Byte);
26
    function NextDouble: Double;
27
    procedure SetSeed(ASeed: Int64);
28
    function GetSeed: Int64;
29
  end;
30

31
  TDelphiRandom = class(TInterfacedObject, IRandom)
32
  public
33
    constructor Create; overload;
34
    constructor Create(Seed: Int64); overload;
35
    function Next: Integer; overload;
36
    function Next(MaxValue: Integer): Integer; overload;
37
    function Next(MinValue, MaxValue: Integer): Integer; overload;
38
    procedure NextBytes(var Bytes: array of Byte);
39
    function NextDouble: Double;
40
    procedure SetSeed(ASeed: Int64);
41
    function GetSeed: Int64;
42
  end;
43

44
implementation
45

46
uses
47
  SysUtils;
48

49
{ TRandom }
50

51
const
52
  CSeedMask      = Int64(1) shl 48 - 1;
53
  CMultiplicator = Int64($00000005DEECE66D);
54
  CConstant      = Int64($000000000000000B);
55
  CSeedSize      = 48 div 8;
56

57
constructor TRandom.Create(Seed: Int64);
58
begin
59
  FSeed := Seed and CSeedMask;
60
end;
61

62
function TRandom.Next: Integer;
63
var
64
  Temp: Int64;
65
begin
66
{$IFOPT Q+}
67
{$DEFINE HasRangeChecks}
68
{$ENDIF}
69

70
  Result := FSeed and MaxInt;
71
  {$RANGECHECKS OFF}
72
  Temp := (FSeed * CMultiplicator + CConstant) and CSeedMask;
73
  FSeed := Temp;
74

75
{$IFDEF HasRangeChecks}
76
{$RANGECHECKS ON}
77
{$ENDIF}
78
end;
79

80
function TRandom.Next(MaxValue: Integer): Integer;
81
begin
82
  Result := UInt64(Cardinal(FSeed)) * UInt64(Cardinal(MaxValue)) shr 32;
83
end;
84

85
function TRandom.Next(MinValue, MaxValue: Integer): Integer;
86
begin
87
  Result := MinValue + Next(MaxValue - MinValue);
88
end;
89

90
procedure TRandom.NextBytes(var Bytes: array of Byte);
91
var
92
  I, Tail: Integer;
93
  Len: Integer;
94
begin
95
  Len := Length(Bytes) and MaxInt;
96
  Tail := Len mod CSeedSize;
97
  Len := Len div CSeedSize;
98
  I := 0;
99
  while I < Len do
100
  begin
101
    Move(FSeed, Bytes[I * CSeedSize], CSeedSize);
102
    Inc(I);
103
    Next;
104
  end;
105
  if Tail > 0 then
106
  begin
107
    Move(FSeed, Bytes[I * CSeedSize], Tail);
108
    Next;
109
  end;
110
end;
111

112
function TRandom.NextDouble: Double;
113
const
114
  Divisor: Double = (1.0 / $1000000) / $1000000;        // 2^-48;
115
begin
116
  Result := FSeed * Divisor;
117
  Next;
118
end;
119

120
function TRandom.GetSeed: Int64;
121
begin
122
  Result := FSeed;
123
end;
124

125
procedure TRandom.SetSeed(ASeed: Int64);
126
begin
127
  FSeed := ASeed and CSeedMask;
128
end;
129

130
{ TDelphiRandom }
131

132
constructor TDelphiRandom.Create(Seed: Int64);
133
begin
134
  System.RandSeed := Integer(Seed);
135
end;
136

137
constructor TDelphiRandom.Create;
138
begin
139
  Randomize;
140
end;
141

142
function TDelphiRandom.GetSeed: Int64;
143
begin
144
  Result := System.RandSeed;
145
end;
146

147
function TDelphiRandom.Next(MinValue, MaxValue: Integer): Integer;
148
begin
149
  Result := MinValue + Next(MaxValue - MinValue);
150
end;
151

152
function TDelphiRandom.Next(MaxValue: Integer): Integer;
153
begin
154
  Result := System.Random(MaxValue);
155
end;
156

157
function TDelphiRandom.Next: Integer;
158
begin
159
  Result := System.Random(MaxInt);
160
end;
161

162
procedure TDelphiRandom.NextBytes(var Bytes: array of Byte);
163
var
164
  I, Tail: Integer;
165
  Len: Integer;
166
const
167
  CSeedSize = SizeOf(System.RandSeed);
168
begin
169
  Len := Length(Bytes) and MaxInt;
170
  Tail := Len mod CSeedSize;
171
  Len := Len div CSeedSize;
172

173
  // Can't use a for-loop, because I is still needed afterward.
174
  I := 0;
175
  while I < Len do
176
  begin
177
    Move(System.RandSeed, Bytes[I * CSeedSize], CSeedSize);
178
    Next;
179
    Inc(I);
180
  end;
181

182
  if Tail > 0 then
183
  begin
184
    Move(System.RandSeed, Bytes[I * CSeedSize], Tail);
185
    Next;
186
  end;
187
end;
188

189
function TDelphiRandom.NextDouble: Double;
190
begin
191
  Result := System.Random;
192
end;
193

194
procedure TDelphiRandom.SetSeed(ASeed: Int64);
195
begin
196
  System.RandSeed := Integer(ASeed);
197
end;
198

199
end.
200

201

202

203