Luxophia

1
unit LUX.Random.PCG.B32;
2

3
interface //#################################################################### ■
4

5
uses LUX,
6
     LUX.Random,
7
     LUX.Random.PCG,
8
     LUX.Random.PCG.B64;
9

10
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
11

12

13
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
14

15
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% T_pcg_state_32
16

17
     (* Representations for the oneseq, mcg, and unique variants *)
18

19
     T_pcg_state_32 = record
20
     private
21
     public
22
       state :Int32u;
23
     end;
24

25
     T_pcg32s_random_t  = T_pcg_state_64;
26
     T_pcg32u_random_t  = T_pcg_state_64;
27
     T_pcg32f_random_t  = T_pcg_state_64;
28

29
     T_pcg32si_random_t = T_pcg_state_32;
30

31
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% T_pcg_state_setseq_32
32

33
     (* Representations setseq variants *)
34

35
     T_pcg_state_setseq_32 = record
36
     private
37
     public
38
       state :Int32u;
39
       inc   :Int32u;
40
     end;
41

42
     T_pcg32_random_t  = T_pcg_state_setseq_64;
43

44
     T_pcg32i_random_t = T_pcg_state_setseq_32;
45

46
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
47

48
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TRandom32PCG<_TSeed_>
49

50
     { http://www.pcg-random.org/using-pcg-c.html }
51

52
     TRandom32PCG<_TSeed_:record> = class( TRandomPCG<_TSeed_> )
53
     private
54
     protected
55
       ///// メソッド
56
       function CalcRandInt08u :Int08u; override;
57
       function CalcRandInt16u :Int16u; override;
58
       function CalcRandInt64u :Int64u; override;
59
     public
60
       ///// メソッド
61
       // Rotate helper functions.
62
       class function pcg_rotr_8( value:Int08u; rot:Int32u ) :Int08u;
63
       class function pcg_rotr_16( value:Int16u; rot:Int32u ) :Int16u;
64
       class function pcg_rotr_32( value:Int32u; rot:Int32u ) :Int32u;
65
       class function pcg_rotr_64( value:Int64u; rot:Int32u ) :Int64u;
66
       // XSH RS
67
       class function pcg_output_xsh_rs_32_16( state:Int32u ) :Int16u;
68
       // XSH RR
69
       class function pcg_output_xsh_rr_32_16( state:Int32u ) :Int16u;
70
       // RXS M XS
71
       class function pcg_output_rxs_m_xs_32_32( state:Int32u ) :Int32u;
72
       // XSL RR
73
       // XSL RR RR
74
       // Multi-step advance functions (jump-ahead, jump-back)
75
       class function pcg_advance_lcg_32( state,delta,cur_mult,cur_plus:Int32u ) :Int32u;
76
       // Functions to advance the underlying LCG
77
       class procedure pcg_oneseq_32_step_r( var rng:T_pcg_state_32 );
78
       class procedure pcg_oneseq_32_advance_r( var rng:T_pcg_state_32; delta:Int32u );
79
       class procedure pcg_mcg_32_step_r( var rng:T_pcg_state_32 );
80
       class procedure pcg_mcg_32_advance_r( var rng:T_pcg_state_32; delta:Int32u );
81
       class procedure pcg_unique_32_step_r( var rng:T_pcg_state_32 );
82
       class procedure pcg_unique_32_advance_r( var rng:T_pcg_state_32; delta:Int32u );
83
       class procedure pcg_setseq_32_step_r( var rng:T_pcg_state_setseq_32 );
84
       class procedure pcg_setseq_32_advance_r( var rng:T_pcg_state_setseq_32; delta:Int32u );
85
       { Functions to seed the RNG state }
86
       class procedure pcg_oneseq_32_srandom_r( var rng:T_pcg_state_32; initstate:Int32u );
87
       class procedure pcg_mcg_32_srandom_r( var rng:T_pcg_state_32; initstate:Int32u );
88
       class procedure pcg_unique_32_srandom_r( var rng:T_pcg_state_32; initstate:Int32u );
89
       class procedure pcg_setseq_32_srandom_r( var rng:T_pcg_state_setseq_32; initstate:Int32u; initseq:Int32u );
90
       { Generation functions for XSH RS }
91
       class function pcg_oneseq_32_xsh_rs_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
92
       class function pcg_oneseq_32_xsh_rs_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
93
       { ----- }
94
       class function pcg_unique_32_xsh_rs_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
95
       class function pcg_unique_32_xsh_rs_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
96
       { ----- }
97
       class function pcg_setseq_32_xsh_rs_16_random_r( var rng:T_pcg_state_setseq_32 ) :Int16u;
98
       class function pcg_setseq_32_xsh_rs_16_boundedrand_r( var rng:T_pcg_state_setseq_32; bound:Int16u ) :Int16u;
99
       { ----- }
100
       class function pcg_mcg_32_xsh_rs_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
101
       class function pcg_mcg_32_xsh_rs_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
102
       { Generation functions for XSH RR }
103
       class function pcg_oneseq_32_xsh_rr_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
104
       class function pcg_oneseq_32_xsh_rr_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
105
       { ----- }
106
       class function pcg_unique_32_xsh_rr_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
107
       class function pcg_unique_32_xsh_rr_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
108
       { ----- }
109
       class function pcg_setseq_32_xsh_rr_16_random_r( var rng:T_pcg_state_setseq_32 ) :Int16u;
110
       class function pcg_setseq_32_xsh_rr_16_boundedrand_r( var rng:T_pcg_state_setseq_32; bound:Int16u ) :Int16u;
111
       { ----- }
112
       class function pcg_mcg_32_xsh_rr_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
113
       class function pcg_mcg_32_xsh_rr_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
114
       { Generation functions for RXS M XS }
115
       class function pcg_oneseq_32_rxs_m_xs_32_random_r( var rng:T_pcg_state_32 ) :Int32u;
116
       class function pcg_oneseq_32_rxs_m_xs_32_boundedrand_r( var rng:T_pcg_state_32; bound:Int32u ) :Int32u;
117
       { ----- }
118
       class function pcg_unique_32_rxs_m_xs_32_random_r( var rng:T_pcg_state_32 ) :Int32u;
119
       class function pcg_unique_32_rxs_m_xs_32_boundedrand_r( var rng:T_pcg_state_32; bound:Int32u ) :Int32u;
120
       { ----- }
121
       class function pcg_setseq_32_rxs_m_xs_32_random_r( var rng:T_pcg_state_setseq_32 ) :Int32u;
122
       class function pcg_setseq_32_rxs_m_xs_32_boundedrand_r( var rng:T_pcg_state_setseq_32; bound:Int32u ) :Int32u;
123
       { Generation functions for XSL RR }
124
       { Generation functions for XSL RR RR }
125
       //// random_r
126
       class function pcg32_random_r( var rng:T_pcg_state_setseq_64 ) :Int32u; inline;
127
       class function pcg32s_random_r( var rng:T_pcg_state_64 ) :Int32u; inline;
128
       class function pcg32u_random_r( var rng:T_pcg_state_64 ) :Int32u; inline;
129
       class function pcg32f_random_r( var rng:T_pcg_state_64 ) :Int32u; inline;
130
       class function pcg32si_random_r( var rng:T_pcg_state_32 ) :Int32u; inline;
131
       class function pcg32i_random_r( var rng:T_pcg_state_setseq_32 ) :Int32u; inline;
132
       //// boundedrand_r
133
       class function pcg32_boundedrand_r( var rng:T_pcg_state_setseq_64; bound:Int32u ) :Int32u; inline;
134
       class function pcg32s_boundedrand_r( var rng:T_pcg_state_64; bound:Int32u ) :Int32u; inline;
135
       class function pcg32u_boundedrand_r( var rng:T_pcg_state_64; bound:Int32u ) :Int32u; inline;
136
       class function pcg32f_boundedrand_r( var rng:T_pcg_state_64; bound:Int32u ) :Int32u; inline;
137
       class function pcg32si_boundedrand_r( var rng:T_pcg_state_32; bound:Int32u ) :Int32u; inline;
138
       class function pcg32i_boundedrand_r( var rng:T_pcg_state_setseq_32; bound:Int32u ) :Int32u; inline;
139
       //// srandom_r
140
       class procedure pcg32_srandom_r( var rng:T_pcg_state_setseq_64; initstate:Int64u; initseq:Int64u ); inline;
141
       class procedure pcg32s_srandom_r( var rng:T_pcg_state_64; initstate:Int64u ); inline;
142
       class procedure pcg32u_srandom_r( var rng:T_pcg_state_64; initstate:Int64u ); inline;
143
       class procedure pcg32f_srandom_r( var rng:T_pcg_state_64; initstate:Int64u ); inline;
144
       class procedure pcg32si_srandom_r( var rng:T_pcg_state_32; initstate:Int32u ); inline;
145
       class procedure pcg32i_srandom_r( var rng:T_pcg_state_setseq_32; initstate:Int32u; initseq:Int32u ); inline;
146
       //// advance_r
147
       class procedure pcg32_advance_r( var rng:T_pcg_state_setseq_64; delta:Int64u ); inline;
148
       class procedure pcg32s_advance_r( var rng:T_pcg_state_64; delta:Int64u ); inline;
149
       class procedure pcg32u_advance_r( var rng:T_pcg_state_64; delta:Int64u ); inline;
150
       class procedure pcg32f_advance_r( var rng:T_pcg_state_64; delta:Int64u ); inline;
151
       class procedure pcg32si_advance_r( var rng:T_pcg_state_32; delta:Int32u ); inline;
152
       class procedure pcg32i_advance_r( var rng:T_pcg_state_setseq_32; delta:Int32u ); inline;
153
     end;
154

155
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TRandom32PCG32
156

157
     TRandom32PCG32 = class( TRandom32PCG<T_pcg_state_32> )
158
     private
159
     protected
160
       ///// メソッド
161
       procedure CalcNextSeed; override;
162
       function CalcRandInt32u :Int32u; override;
163
     public
164
       constructor CreateFromRand( const Random_:IRandom ); overload; override;
165
     end;
166

167
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TRandom32PCG32x31
168

169
     TRandom32PCG32x31 = class( TRandom32PCG<T_pcg_state_setseq_32> )
170
     private
171
     protected
172
       ///// メソッド
173
       procedure CalcNextSeed; override;
174
       function CalcRandInt32u :Int32u; override;
175
     public
176
       constructor CreateFromRand( const Random_:IRandom ); overload; override;
177
     end;
178

179
const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
180

181
      PCG_DEFAULT_MULTIPLIER_32 :Int32u = 747796405;
182
      PCG_DEFAULT_INCREMENT_32  :Int32u = 2891336453;
183

184
      (*
185
       * Static initialization constants (if you can't call srandom for some
186
       * bizarre reason).
187
       *)
188

189
      PCG_STATE_ONESEQ_32_INITIALIZER :T_pcg_state_32        = ( state:$46b56677                               );
190
      PCG_STATE_UNIQUE_32_INITIALIZER :T_pcg_state_32        = ( state:$46b56677                               );  //= PCG_STATE_ONESEQ_32_INITIALIZER
191
      PCG_STATE_MCG_32_INITIALIZER    :T_pcg_state_32        = ( state:$d15ea5e5                               );
192
      PCG_STATE_SETSEQ_32_INITIALIZER :T_pcg_state_setseq_32 = ( state:$ec02d89b;         inc:$94b95bdb        );
193

194
      PCG_STATE_ONESEQ_64_INITIALIZER :T_pcg_state_64        = ( state:$4d595df4d0f33173                        );
195
      PCG_STATE_UNIQUE_64_INITIALIZER :T_pcg_state_64        = ( state:$4d595df4d0f33173                        );  //= PCG_STATE_ONESEQ_64_INITIALIZER
196
      PCG_STATE_MCG_64_INITIALIZER    :T_pcg_state_64        = ( state:$cafef00dd15ea5e5                        );
197
      PCG_STATE_SETSEQ_64_INITIALIZER :T_pcg_state_setseq_64 = ( state:$853c49e6748fea9b; inc:$da3e39cb94b95bdb );
198

199
      PCG32_INITIALIZER               :T_pcg_state_setseq_64 = ( state:$853c49e6748fea9b; inc:$da3e39cb94b95bdb );  //= PCG_STATE_SETSEQ_64_INITIALIZER
200
      PCG32U_INITIALIZER              :T_pcg_state_64        = ( state:$4d595df4d0f33173                        );  //= PCG_STATE_UNIQUE_64_INITIALIZER
201
      PCG32S_INITIALIZER              :T_pcg_state_64        = ( state:$4d595df4d0f33173                        );  //= PCG_STATE_ONESEQ_64_INITIALIZER
202
      PCG32F_INITIALIZER              :T_pcg_state_64        = ( state:$cafef00dd15ea5e5                        );  //= PCG_STATE_MCG_64_INITIALIZER
203
      PCG32SI_INITIALIZER             :T_pcg_state_32        = ( state:$46b56677                                );  //= PCG_STATE_ONESEQ_32_INITIALIZER
204
      PCG32I_INITIALIZER              :T_pcg_state_setseq_32 = ( state:$ec02d89b;         inc:$94b95bdb         );  //= PCG_STATE_SETSEQ_32_INITIALIZER
205

206
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
207

208
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
209

210
implementation //############################################################### ■
211

212
uses System.SysUtils;
213

214
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
215

216
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
217

218
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TRandom32PCG<_TSeed_>
219

220
{ https://github.com/imneme/pcg-c }
221

222
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
223

224
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
225

226
/////////////////////////////////////////////////////////////////////// メソッド
227

228
function TRandom32PCG<_TSeed_>.CalcRandInt08u :Int08u;
229
begin
230
     Result := CalcRandInt16u shr 08;
231
end;
232

233
function TRandom32PCG<_TSeed_>.CalcRandInt16u :Int16u;
234
begin
235
     Result := CalcRandInt32u shr 16;
236
end;
237

238
function TRandom32PCG<_TSeed_>.CalcRandInt64u :Int64u;
239
begin
240
     Result := Int64u( CalcRandInt32u ) shl 32 or CalcRandInt32u;
241
end;
242

243
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
244

245
/////////////////////////////////////////////////////////////////////// メソッド
246

247
{ https://github.com/imneme/pcg-c/blob/master/include/pcg_variants.h }
248

249
(*
250
 * Rotate helper functions.
251
 *)
252

253
class function TRandom32PCG<_TSeed_>.pcg_rotr_8( value:Int08u; rot:Int32u ) :Int08u;
254
begin
255
     (* Unfortunately, clang is kinda pathetic when it comes to properly
256
      * recognizing idiomatic rotate code, so for clang we actually provide
257
      * assembler directives (enabled with PCG_USE_INLINE_ASM).  Boo, hiss.
258
      *)
259

260
     Result := ( value shr rot ) or ( value shl ( -rot and 07 ) );
261
end;
262

263
class function TRandom32PCG<_TSeed_>.pcg_rotr_16( value:Int16u; rot:Int32u ) :Int16u;
264
begin
265
     Result := ( value shr rot ) or ( value shl ( -rot and 15 ) );
266
end;
267

268
class function TRandom32PCG<_TSeed_>.pcg_rotr_32( value:Int32u; rot:Int32u ) :Int32u;
269
begin
270
     Result := ( value shr rot ) or ( value shl ( -rot and 31 ) );
271
end;
272

273
class function TRandom32PCG<_TSeed_>.pcg_rotr_64( value:Int64u; rot:Int32u ) :Int64u;
274
begin
275
     Result := ( value shr rot ) or ( value shl ( -rot and 63 ) );
276
end;
277

278
(*
279
 * Output functions.  These are the core of the PCG generation scheme.
280
 *)
281

282
// XSH RS
283

284
class function TRandom32PCG<_TSeed_>.pcg_output_xsh_rs_32_16( state:Int32u ) :Int16u;
285
begin
286
     Result := Int16u( ( ( state shr 11 ) xor state ) shr ( ( state shr 30 ) + 11 ) );
287
end;
288

289
// XSH RR
290

291
class function TRandom32PCG<_TSeed_>.pcg_output_xsh_rr_32_16( state:Int32u ) :Int16u;
292
begin
293
     Result := pcg_rotr_16( ( ( state shr 10 ) xor state ) shr 12, state shr 28 );
294
end;
295

296
// RXS M XS
297

298
class function TRandom32PCG<_TSeed_>.pcg_output_rxs_m_xs_32_32( state:Int32u ) :Int32u;
299
var
300
   word :Int32u;
301
begin
302
     word := ( ( state shr ( ( state shr 28 ) + 4 ) ) xor state ) * 277803737;
303

304
     Result := ( word shr 22 ) xor word;
305
end;
306

307
// XSL RR (only defined for >= 64 bits)
308

309
// XSL RR RR (only defined for >= 64 bits)
310

311
(* Functions to advance the underlying LCG, one version for each size and
312
 * each style.  These functions are considered semi-private.  There is rarely
313
 * a good reason to call them directly.
314
 *)
315

316
class procedure TRandom32PCG<_TSeed_>.pcg_oneseq_32_step_r( var rng:T_pcg_state_32 );
317
begin
318
     rng.state := rng.state * PCG_DEFAULT_MULTIPLIER_32 + PCG_DEFAULT_INCREMENT_32;
319
end;
320

321
class procedure TRandom32PCG<_TSeed_>.pcg_oneseq_32_advance_r( var rng:T_pcg_state_32; delta:Int32u );
322
begin
323
     rng.state := pcg_advance_lcg_32( rng.state, delta, PCG_DEFAULT_MULTIPLIER_32, PCG_DEFAULT_INCREMENT_32 );
324
end;
325

326
class procedure TRandom32PCG<_TSeed_>.pcg_mcg_32_step_r( var rng:T_pcg_state_32 );
327
begin
328
     rng.state := rng.state * PCG_DEFAULT_MULTIPLIER_32;
329
end;
330

331
class procedure TRandom32PCG<_TSeed_>.pcg_mcg_32_advance_r( var rng:T_pcg_state_32; delta:Int32u );
332
begin
333
     rng.state := pcg_advance_lcg_32( rng.state, delta, PCG_DEFAULT_MULTIPLIER_32, 0 );
334
end;
335

336
class procedure TRandom32PCG<_TSeed_>.pcg_unique_32_step_r( var rng:T_pcg_state_32 );
337
begin
338
     rng.state := rng.state * PCG_DEFAULT_MULTIPLIER_32 + Int32u( IntPtr( @rng ) or 1 );
339
end;
340

341
class procedure TRandom32PCG<_TSeed_>.pcg_unique_32_advance_r( var rng:T_pcg_state_32; delta:Int32u );
342
begin
343
     rng.state := pcg_advance_lcg_32( rng.state, delta, PCG_DEFAULT_MULTIPLIER_32, Int32u( IntPtr( @rng ) or 1 ) );
344
end;
345

346
class procedure TRandom32PCG<_TSeed_>.pcg_setseq_32_step_r( var rng:T_pcg_state_setseq_32 );
347
begin
348
     rng.state := rng.state * PCG_DEFAULT_MULTIPLIER_32 + rng.inc;
349
end;
350

351
class procedure TRandom32PCG<_TSeed_>.pcg_setseq_32_advance_r( var rng:T_pcg_state_setseq_32; delta:Int32u );
352
begin
353
     rng.state := pcg_advance_lcg_32( rng.state, delta, PCG_DEFAULT_MULTIPLIER_32, rng.inc );
354
end;
355

356
(* Multi-step advance functions (jump-ahead, jump-back) *)
357

358
{ https://github.com/imneme/pcg-c/blob/master/src/pcg-advance-32.c }
359

360
class function TRandom32PCG<_TSeed_>.pcg_advance_lcg_32( state,delta,cur_mult,cur_plus:Int32u ) :Int32u;
361
var
362
   acc_mult, acc_plus :Int32u;
363
begin
364
     acc_mult := 1;
365
     acc_plus := 0;
366

367
     while delta > 0 do
368
     begin
369
          if delta and 1 <> 0 then
370
          begin
371
               acc_mult := acc_mult * cur_mult;
372
               acc_plus := acc_plus * cur_mult + cur_plus;
373
          end;
374

375
          cur_plus := ( cur_mult + 1 ) * cur_plus;
376
          cur_mult := cur_mult * cur_mult;
377

378
          delta := delta div 2;
379
     end;
380

381
     Result := acc_mult * state + acc_plus;
382
end;
383

384
(* Functions to seed the RNG state, one version for each size and each
385
 * style.  Unlike the step functions, regular users can and should call
386
 * these functions.
387
 *)
388

389
class procedure TRandom32PCG<_TSeed_>.pcg_oneseq_32_srandom_r( var rng:T_pcg_state_32; initstate:Int32u );
390
begin
391
     rng.state := 0;
392
     pcg_oneseq_32_step_r( rng );
393
     rng.state := rng.state + initstate;
394
     pcg_oneseq_32_step_r( rng );
395
end;
396

397
class procedure TRandom32PCG<_TSeed_>.pcg_mcg_32_srandom_r( var rng:T_pcg_state_32; initstate:Int32u );
398
begin
399
     rng.state := initstate or 1;
400
end;
401

402
class procedure TRandom32PCG<_TSeed_>.pcg_unique_32_srandom_r( var rng:T_pcg_state_32; initstate:Int32u );
403
begin
404
     rng.state := 0;
405
     pcg_unique_32_step_r( rng );
406
     rng.state := rng.state + initstate;
407
     pcg_unique_32_step_r( rng );
408
end;
409

410
class procedure TRandom32PCG<_TSeed_>.pcg_setseq_32_srandom_r( var rng:T_pcg_state_setseq_32; initstate:Int32u; initseq:Int32u );
411
begin
412
     rng.state := 0;
413
     rng.inc := ( initseq shl 1 ) or 1;
414
     pcg_setseq_32_step_r( rng );
415
     rng.state := rng.state + initstate;
416
     pcg_setseq_32_step_r( rng );
417
end;
418

419
(* Generation functions for XSH RS *)
420

421
class function TRandom32PCG<_TSeed_>.pcg_oneseq_32_xsh_rs_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
422
var
423
   oldstate :Int32u;
424
begin
425
     oldstate := rng.state;
426
     pcg_oneseq_32_step_r( rng );
427
     Result := pcg_output_xsh_rs_32_16( oldstate );
428
end;
429

430
class function TRandom32PCG<_TSeed_>.pcg_oneseq_32_xsh_rs_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
431
var
432
   threshold, r :Int16u;
433
begin
434
     threshold := Int16u( -bound ) mod bound;
435

436
     repeat
437
           r := pcg_oneseq_32_xsh_rs_16_random_r( rng );
438

439
     until r >= threshold;
440

441
     Result := r mod bound;
442
end;
443

444
//------------------------------------------------------------------------------
445

446
class function TRandom32PCG<_TSeed_>.pcg_unique_32_xsh_rs_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
447
var
448
   oldstate :Int32u;
449
begin
450
     oldstate := rng.state;
451
     pcg_unique_32_step_r( rng );
452
     Result := pcg_output_xsh_rs_32_16( oldstate );
453
end;
454

455
class function TRandom32PCG<_TSeed_>.pcg_unique_32_xsh_rs_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
456
var
457
   threshold, r :Int16u;
458
begin
459
     threshold := Int16u( -bound ) mod bound;
460

461
     repeat
462
           r := pcg_unique_32_xsh_rs_16_random_r( rng );
463

464
     until r >= threshold;
465

466
     Result := r mod bound;
467
end;
468

469
//------------------------------------------------------------------------------
470

471
class function TRandom32PCG<_TSeed_>.pcg_setseq_32_xsh_rs_16_random_r( var rng:T_pcg_state_setseq_32 ) :Int16u;
472
var
473
   oldstate :Int32u;
474
begin
475
     oldstate := rng.state;
476
     pcg_setseq_32_step_r( rng );
477
     Result := pcg_output_xsh_rs_32_16( oldstate );
478
end;
479

480
class function TRandom32PCG<_TSeed_>.pcg_setseq_32_xsh_rs_16_boundedrand_r( var rng:T_pcg_state_setseq_32; bound:Int16u ) :Int16u;
481
var
482
   threshold, r :Int16u;
483
begin
484
     threshold := Int16u( -bound ) mod bound;
485

486
     repeat
487
           r := pcg_setseq_32_xsh_rs_16_random_r( rng );
488

489
     until r >= threshold;
490

491
     Result := r mod bound;
492
end;
493

494
//------------------------------------------------------------------------------
495

496
class function TRandom32PCG<_TSeed_>.pcg_mcg_32_xsh_rs_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
497
var
498
   oldstate :Int32u;
499
begin
500
     oldstate := rng.state;
501
     pcg_mcg_32_step_r( rng );
502
     Result := pcg_output_xsh_rs_32_16( oldstate );
503
end;
504

505
class function TRandom32PCG<_TSeed_>.pcg_mcg_32_xsh_rs_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
506
var
507
   threshold, r :Int16u;
508
begin
509
     threshold := Int16u( -bound ) mod bound;
510

511
     repeat
512
           r := pcg_mcg_32_xsh_rs_16_random_r( rng );
513

514
     until r >= threshold;
515

516
     Result := r mod bound;
517
end;
518

519
//---------------------------------------------- Generation functions for XSH RR
520

521
class function TRandom32PCG<_TSeed_>.pcg_oneseq_32_xsh_rr_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
522
var
523
   oldstate :Int32u;
524
begin
525
     oldstate := rng.state;
526
     pcg_oneseq_32_step_r( rng );
527
     Result := pcg_output_xsh_rr_32_16( oldstate );
528
end;
529

530
class function TRandom32PCG<_TSeed_>.pcg_oneseq_32_xsh_rr_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
531
var
532
   threshold, r :Int16u;
533
begin
534
     threshold := Int16u( -bound ) mod bound;
535

536
     repeat
537
           r := pcg_oneseq_32_xsh_rr_16_random_r( rng );
538

539
     until r >= threshold;
540

541
     Result := r mod bound;
542
end;
543

544
//------------------------------------------------------------------------------
545

546
class function TRandom32PCG<_TSeed_>.pcg_unique_32_xsh_rr_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
547
var
548
   oldstate :Int32u;
549
begin
550
     oldstate := rng.state;
551
     pcg_unique_32_step_r( rng );
552
     Result := pcg_output_xsh_rr_32_16( oldstate );
553
end;
554

555
class function TRandom32PCG<_TSeed_>.pcg_unique_32_xsh_rr_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
556
var
557
   threshold, r :Int16u;
558
begin
559
     threshold := Int16u( -bound ) mod bound;
560

561
     repeat
562
           r := pcg_unique_32_xsh_rr_16_random_r( rng );
563

564
     until r >= threshold;
565

566
     Result := r mod bound;
567
end;
568

569
//------------------------------------------------------------------------------
570

571
class function TRandom32PCG<_TSeed_>.pcg_setseq_32_xsh_rr_16_random_r( var rng:T_pcg_state_setseq_32 ) :Int16u;
572
var
573
   oldstate :Int32u;
574
begin
575
     oldstate := rng.state;
576
     pcg_setseq_32_step_r( rng );
577
     Result := pcg_output_xsh_rr_32_16( oldstate );
578
end;
579

580
class function TRandom32PCG<_TSeed_>.pcg_setseq_32_xsh_rr_16_boundedrand_r( var rng:T_pcg_state_setseq_32; bound:Int16u ) :Int16u;
581
var
582
   threshold, r :Int16u;
583
begin
584
     threshold := Int16u( -bound ) mod bound;
585

586
     repeat
587
           r := pcg_setseq_32_xsh_rr_16_random_r( rng );
588

589
     until r >= threshold;
590

591
     Result := r mod bound;
592
end;
593

594
//------------------------------------------------------------------------------
595

596
class function TRandom32PCG<_TSeed_>.pcg_mcg_32_xsh_rr_16_random_r( var rng:T_pcg_state_32 ) :Int16u;
597
var
598
   oldstate :Int32u;
599
begin
600
     oldstate := rng.state;
601
     pcg_mcg_32_step_r( rng );
602
     Result := pcg_output_xsh_rr_32_16( oldstate );
603
end;
604

605
class function TRandom32PCG<_TSeed_>.pcg_mcg_32_xsh_rr_16_boundedrand_r( var rng:T_pcg_state_32; bound:Int16u ) :Int16u;
606
var
607
   threshold, r :Int16u;
608
begin
609
     threshold := Int16u( -bound ) mod bound;
610

611
     repeat
612
           r := pcg_mcg_32_xsh_rr_16_random_r( rng );
613

614
     until r >= threshold;
615

616
     Result := r mod bound;
617
end;
618

619
//-------------------------------------------- Generation functions for RXS M XS
620

621
class function TRandom32PCG<_TSeed_>.pcg_oneseq_32_rxs_m_xs_32_random_r( var rng:T_pcg_state_32 ) :Int32u;
622
var
623
   oldstate :Int32u;
624
begin
625
     oldstate := rng.state;
626
     pcg_oneseq_32_step_r( rng );
627
     Result := pcg_output_rxs_m_xs_32_32( oldstate );
628
end;
629

630
class function TRandom32PCG<_TSeed_>.pcg_oneseq_32_rxs_m_xs_32_boundedrand_r( var rng:T_pcg_state_32; bound:Int32u ) :Int32u;
631
var
632
   threshold, r :Int32u;
633
begin
634
     threshold := -bound mod bound;
635

636
     repeat
637
           r := pcg_oneseq_32_rxs_m_xs_32_random_r( rng );
638

639
     until r >= threshold;
640

641
     Result := r mod bound;
642
end;
643

644
//------------------------------------------------------------------------------
645

646
class function TRandom32PCG<_TSeed_>.pcg_unique_32_rxs_m_xs_32_random_r( var rng:T_pcg_state_32 ) :Int32u;
647
var
648
   oldstate :Int32u;
649
begin
650
     oldstate := rng.state;
651
     pcg_unique_32_step_r( rng );
652
     Result := pcg_output_rxs_m_xs_32_32( oldstate );
653
end;
654

655
class function TRandom32PCG<_TSeed_>.pcg_unique_32_rxs_m_xs_32_boundedrand_r( var rng:T_pcg_state_32; bound:Int32u ) :Int32u;
656
var
657
   threshold, r :Int32u;
658
begin
659
     threshold := -bound mod bound;
660

661
     repeat
662
           r := pcg_unique_32_rxs_m_xs_32_random_r( rng );
663

664
     until r >= threshold;
665

666
     Result := r mod bound;
667
end;
668

669
//------------------------------------------------------------------------------
670

671
class function TRandom32PCG<_TSeed_>.pcg_setseq_32_rxs_m_xs_32_random_r( var rng:T_pcg_state_setseq_32 ) :Int32u;
672
var
673
   oldstate :Int32u;
674
begin
675
     oldstate := rng.state;
676
     pcg_setseq_32_step_r( rng );
677
     Result := pcg_output_rxs_m_xs_32_32( oldstate );
678
end;
679

680
class function TRandom32PCG<_TSeed_>.pcg_setseq_32_rxs_m_xs_32_boundedrand_r( var rng:T_pcg_state_setseq_32; bound:Int32u ) :Int32u;
681
var
682
   threshold, r :Int32u;
683
begin
684
     threshold := -bound mod bound;
685

686
     repeat
687
           r := pcg_setseq_32_rxs_m_xs_32_random_r( rng );
688

689
     until r >= threshold;
690

691
     Result := r mod bound;
692
end;
693

694
//---------------------------------------------- Generation functions for XSL RR
695

696
//------------------------------------------- Generation functions for XSL RR RR
697

698
/////////////////////////////////////////////////////////////////////// random_r
699

700
class function TRandom32PCG<_TSeed_>.pcg32_random_r( var rng:T_pcg_state_setseq_64 ) :Int32u;
701
begin
702
     Result := TRandom64PCG<_TSeed_>.pcg_setseq_64_xsh_rr_32_random_r( rng );
703
end;
704

705
class function TRandom32PCG<_TSeed_>.pcg32s_random_r( var rng:T_pcg_state_64 ) :Int32u;
706
begin
707
     Result := TRandom64PCG<_TSeed_>.pcg_oneseq_64_xsh_rr_32_random_r( rng );
708
end;
709

710
class function TRandom32PCG<_TSeed_>.pcg32u_random_r( var rng:T_pcg_state_64 ) :Int32u;
711
begin
712
     Result := TRandom64PCG<_TSeed_>.pcg_unique_64_xsh_rr_32_random_r( rng );
713
end;
714

715
class function TRandom32PCG<_TSeed_>.pcg32f_random_r( var rng:T_pcg_state_64 ) :Int32u;
716
begin
717
     Result := TRandom64PCG<_TSeed_>.pcg_mcg_64_xsh_rs_32_random_r( rng );
718
end;
719

720
class function TRandom32PCG<_TSeed_>.pcg32si_random_r( var rng:T_pcg_state_32 ) :Int32u;
721
begin
722
     Result := pcg_oneseq_32_rxs_m_xs_32_random_r( rng );
723
end;
724

725
class function TRandom32PCG<_TSeed_>.pcg32i_random_r( var rng:T_pcg_state_setseq_32 ) :Int32u;
726
begin
727
     Result := pcg_setseq_32_rxs_m_xs_32_random_r( rng );
728
end;
729

730
////////////////////////////////////////////////////////////////// boundedrand_r
731

732
class function TRandom32PCG<_TSeed_>.pcg32_boundedrand_r( var rng:T_pcg_state_setseq_64; bound:Int32u ) :Int32u;
733
begin
734
     Result := TRandom64PCG<_TSeed_>.pcg_setseq_64_xsh_rr_32_boundedrand_r( rng, bound );
735
end;
736

737
class function TRandom32PCG<_TSeed_>.pcg32s_boundedrand_r( var rng:T_pcg_state_64; bound:Int32u ) :Int32u;
738
begin
739
     Result := TRandom64PCG<_TSeed_>.pcg_oneseq_64_xsh_rr_32_boundedrand_r( rng, bound );
740
end;
741

742
class function TRandom32PCG<_TSeed_>.pcg32u_boundedrand_r( var rng:T_pcg_state_64; bound:Int32u ) :Int32u;
743
begin
744
     Result := TRandom64PCG<_TSeed_>.pcg_unique_64_xsh_rr_32_boundedrand_r( rng, bound );
745
end;
746

747
class function TRandom32PCG<_TSeed_>.pcg32f_boundedrand_r( var rng:T_pcg_state_64; bound:Int32u ) :Int32u;
748
begin
749
     Result := TRandom64PCG<_TSeed_>.pcg_mcg_64_xsh_rs_32_boundedrand_r( rng, bound );
750
end;
751

752
class function TRandom32PCG<_TSeed_>.pcg32si_boundedrand_r( var rng:T_pcg_state_32; bound:Int32u ) :Int32u;
753
begin
754
     Result := pcg_oneseq_32_rxs_m_xs_32_boundedrand_r( rng, bound );
755
end;
756

757
class function TRandom32PCG<_TSeed_>.pcg32i_boundedrand_r( var rng:T_pcg_state_setseq_32; bound:Int32u ) :Int32u;
758
begin
759
     Result := pcg_setseq_32_rxs_m_xs_32_boundedrand_r( rng, bound );
760
end;
761

762
////////////////////////////////////////////////////////////////////// srandom_r
763

764
class procedure TRandom32PCG<_TSeed_>.pcg32_srandom_r( var rng:T_pcg_state_setseq_64; initstate:Int64u; initseq:Int64u );
765
begin
766
     TRandom64PCG<_TSeed_>.pcg_setseq_64_srandom_r( rng, initstate, initseq );
767
end;
768

769
class procedure TRandom32PCG<_TSeed_>.pcg32s_srandom_r( var rng:T_pcg_state_64; initstate:Int64u );
770
begin
771
     TRandom64PCG<_TSeed_>.pcg_oneseq_64_srandom_r( rng, initstate );
772
end;
773

774
class procedure TRandom32PCG<_TSeed_>.pcg32u_srandom_r( var rng:T_pcg_state_64; initstate:Int64u );
775
begin
776
     TRandom64PCG<_TSeed_>.pcg_unique_64_srandom_r( rng, initstate );
777
end;
778

779
class procedure TRandom32PCG<_TSeed_>.pcg32f_srandom_r( var rng:T_pcg_state_64; initstate:Int64u );
780
begin
781
     TRandom64PCG<_TSeed_>.pcg_mcg_64_srandom_r( rng, initstate );
782
end;
783

784
class procedure TRandom32PCG<_TSeed_>.pcg32si_srandom_r( var rng:T_pcg_state_32; initstate:Int32u );
785
begin
786
     pcg_oneseq_32_srandom_r( rng, initstate );
787
end;
788

789
class procedure TRandom32PCG<_TSeed_>.pcg32i_srandom_r( var rng:T_pcg_state_setseq_32; initstate:Int32u; initseq:Int32u );
790
begin
791
     pcg_setseq_32_srandom_r( rng, initstate, initseq );
792
end;
793

794
////////////////////////////////////////////////////////////////////// advance_r
795

796
class procedure TRandom32PCG<_TSeed_>.pcg32_advance_r( var rng:T_pcg_state_setseq_64; delta:Int64u );
797
begin
798
     TRandom64PCG<_TSeed_>.pcg_setseq_64_advance_r( rng, delta );
799
end;
800

801
class procedure TRandom32PCG<_TSeed_>.pcg32s_advance_r( var rng:T_pcg_state_64; delta:Int64u );
802
begin
803
     TRandom64PCG<_TSeed_>.pcg_oneseq_64_advance_r( rng, delta );
804
end;
805

806
class procedure TRandom32PCG<_TSeed_>.pcg32u_advance_r( var rng:T_pcg_state_64; delta:Int64u );
807
begin
808
     TRandom64PCG<_TSeed_>.pcg_unique_64_advance_r( rng, delta );
809
end;
810

811
class procedure TRandom32PCG<_TSeed_>.pcg32f_advance_r( var rng:T_pcg_state_64; delta:Int64u );
812
begin
813
     TRandom64PCG<_TSeed_>.pcg_mcg_64_advance_r( rng, delta );
814
end;
815

816
class procedure TRandom32PCG<_TSeed_>.pcg32si_advance_r( var rng:T_pcg_state_32; delta:Int32u );
817
begin
818
     pcg_oneseq_32_advance_r( rng, delta );
819
end;
820

821
class procedure TRandom32PCG<_TSeed_>.pcg32i_advance_r( var rng:T_pcg_state_setseq_32; delta:Int32u );
822
begin
823
     pcg_setseq_32_advance_r( rng, delta );
824
end;
825

826
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TRandom32PCG32
827

828
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
829

830
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
831

832
/////////////////////////////////////////////////////////////////////// メソッド
833

834
procedure TRandom32PCG32.CalcNextSeed;
835
begin
836
     pcg_oneseq_32_step_r( _Seed );
837
end;
838

839
//------------------------------------------------------------------------------
840

841
function TRandom32PCG32.CalcRandInt32u :Int32u;
842
begin
843
     Result := pcg_output_rxs_m_xs_32_32( _Seed.state );
844
end;
845

846
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
847

848
constructor TRandom32PCG32.CreateFromRand( const Random_:IRandom );
849
var
850
   S :T_pcg_state_32;
851
begin
852
     pcg_oneseq_32_srandom_r( S, Random_.DrawRandInt32u );
853

854
     Create( S );
855
end;
856

857
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TRandom32PCG32x31
858

859
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
860

861
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
862

863
/////////////////////////////////////////////////////////////////////// メソッド
864

865
procedure TRandom32PCG32x31.CalcNextSeed;
866
begin
867
     pcg_setseq_32_step_r( _Seed );
868
end;
869

870
//------------------------------------------------------------------------------
871

872
function TRandom32PCG32x31.CalcRandInt32u :Int32u;
873
begin
874
     Result := pcg_output_rxs_m_xs_32_32( _Seed.state );
875
end;
876

877
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
878

879
constructor TRandom32PCG32x31.CreateFromRand( const Random_:IRandom );
880
var
881
   S :T_pcg_state_setseq_32;
882
begin
883
     pcg_setseq_32_srandom_r( S, Random_.DrawRandInt32u, Random_.DrawRandInt32u );
884

885
     Create( S );
886
end;
887

888
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
889

890
//############################################################################## □
891

892
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
893

894
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
895

896
end. //######################################################################### ■
897