Code: Select all
#ifndef __FBMATH_BI__
#define __FBMATH_BI__
# if __FB_LANG__ = "qb"
# error not supported in qb dialect
# endif
Namespace FbmathBItest
Type genrand Extends Object
Declare abstract Function Rnd() As Double
Declare abstract Function rnd32() As Ulong
Declare abstract Function range(f As Long,l As Long) As Long
End Type
'' "FAST" PRNG from 'Numerical recipes in C' chapter 7.1
''
Type RndFAST32 Extends genrand
iseed As Ulong = 327680
Declare virtual Function Rnd() As Double override
Declare virtual Function rnd32() As Ulong override
Declare virtual Function range(f As Long,l As Long) As Long override
End Type
Private Function RndFAST32.rnd32() As Ulong
this.iseed = this.iseed * 1664525 + 1013904223
Return this.iseed
End Function
Private Function RndFAST32.rnd() As Double
Return this.rnd32()/Cdbl(4294967296ull)
End Function
Private Function RndFAST32.range(f As Long,l As Long) As Long
Return (this.rnd32() Mod ((l-f)+1)) + f
End Function
''
'' Middle Square Weyl Sequence PRNG / Bernard Widynski / 20 May 2020
'' https://arxiv.org/abs/1704.00358v5
''
''
Type RndMSWS32 Extends genrand
s As Ulongint = &hb5ad4eceda1ce2a9ull
w As Ulongint
x As Ulongint
Declare virtual Function Rnd() As Double override
Declare virtual Function rnd32() As Ulong override
Declare virtual Function range(f As Long,l As Long) As Long override
End Type
Private Function RndMSWS32.rnd32() As Ulong
With This
.x *= .x
.w += .s
.x += .w
.x = ( .x Shl 32 ) Or ( .x Shr 32 )
Return .x
End With
End Function
Private Function RndMSWS32.rnd() As Double
Return this.rnd32()/Cdbl(4294967296ull)
End Function
Private Function RndMSWS32.range(f As Long,l As Long) As Long
Return (this.rnd32() Mod ((l-f)+1)) + f
End Function
''
'' Squares: A Fast Counter Based PRNG / Bernard Widynski / 5 May 2020
'' https://arxiv.org/abs/2004.06278
''
Type RndSquares32 Extends genrand
key As Ulongint = &hb5ad4eceda1ce2a9ull
ctr As Ulongint
Declare virtual Function Rnd() As Double override
Declare virtual Function rnd32() As Ulong override
Declare virtual Function range(f As Long,l As Long) As Long override
End Type
Private Function RndSquares32.rnd32() As Ulong
Dim As Ulongint x = this.key * this.ctr
Dim As Ulongint y = x
Dim As Ulongint z = y + key
x = x * x + y
x = ( x Shr 32 ) Or ( x Shl 32 )
x = x * x + z
x = ( x Shr 32 ) Or ( x Shl 32 )
this.ctr += 1
Return (x * x + y) Shr 32
End Function
Private Function RndSquares32.rnd() As Double
Return this.rnd32()/Cdbl(4294967296ull)
End Function
Private Function RndSquares32.range(f As Long,l As Long) As Long
Return (this.rnd32() Mod ((l-f)+1)) + f
End Function
''
'' *Really* minimal PCG32 code / (c) 2014 M.E. O'Neill / pcg-random.org
'' Licensed under Apache License 2.0 (NO WARRANTY, etc. see website)
''
Type RndPCG32 Extends genrand
state As Ulongint=1000000
inc_ As Ulongint
Declare virtual Function Rnd() As Double override
Declare virtual Function rnd32() As Ulong override
Declare virtual Function range(f As Long,l As Long) As Long override
End Type
Private Function RndPCG32.rnd32() As Ulong
With This
Var oldstate = this.state
'' Advance internal state
.state = oldstate * 6364136223846793005ULL + ( .inc_ Or 1 )
'' Calculate output function (XSH RR), uses old state for max ILP
Dim As Ulong xorshifted = ((oldstate Shr 18u) xor oldstate) Shr 27u
Dim As Ulong rot = oldstate Shr 59u
Return (xorshifted Shr rot) Or (xorshifted Shl ((-rot) And 31))
End With
End Function
Private Function RndPCG32.rnd() As Double
Return this.rnd32()/Cdbl(4294967296ull)
End Function
Private Function RndPCG32.range(f As Long,l As Long) As Long
Return (this.rnd32() Mod ((l-f)+1)) + f
End Function
Function randomF(Byref method As genrand) As Double
If method Is RndFAST32 Then
Static As rndfast32 k
Return k.rnd()
End If
If method Is RndMSWS32 Then
Static As RndMSWS32 k
Return k.rnd()
End If
If method Is RndSquares32 Then
Static As RndSquares32 k
Return k.rnd()
End If
If method Is RndPCG32 Then
Static As RndPCG32 k
Return k.rnd()
End If
End Function
Function randomI(Byref method As genrand) As Ulong
If method Is RndFAST32 Then
Static As rndfast32 k
Return k.rnd32()
End If
If method Is RndMSWS32 Then
Static As RndMSWS32 k
Return k.rnd32()
End If
If method Is RndSquares32 Then
Static As RndSquares32 k
Return k.rnd32()
End If
If method Is RndPCG32 Then
Static As RndPCG32 k
Return k.rnd32()
End If
End Function
Function rangeI(Byref method As genrand,f As Long,l As Long) As Long
If method Is RndFAST32 Then
Static As rndfast32 k
Return k.range(f,l)
End If
If method Is RndMSWS32 Then
Static As RndMSWS32 k
Return k.range(f,l)
End If
If method Is RndSquares32 Then
Static As RndSquares32 k
Return k.range(f,l)
End If
If method Is RndPCG32 Then
Static As RndPCG32 k
Return k.range(f,l)
End If
End Function
End Namespace
#endif '' __FBMATH_BI__
'===================================================================
Using FbmathBItest
Print "Warmup"
For k As Long=1 To 4
Print randomf(RndFAST32),randomi(RndFAST32),rangei(RndFAST32,-5,5),"RndFAST32"
Print randomf(RndMSWS32),randomi(RndMSWS32),rangei(RndMSWS32,-5,5),"RndMSWS32"
Print randomf(RndSquares32),randomi(RndSquares32),rangei(RndSquares32,-5,5),"RndSquares32"
Print randomf(RndPCG32),randomi(RndPCG32),rangei(RndPCG32,-5,5),"RndPCG32"
Print
Next k
Print "Buckets"
Print "RndFAST32","RndMSWS32","RndSquares32","RndPCG32"
Dim As Long a(1 To 5),b(1 To 5),c(1 To 5),d(1 To 5)
Dim As Long lim=1000000
For n As Long=1 To lim
a(rangei(RndFAST32,1,5))+=1
b(rangei(RndMSWS32,1,5))+=1
c(rangei(RndSquares32,1,5))+=1
d(rangei(RndPCG32,1,5))+=1
Next
For n As Long=1 To 5
Print a(n),b(n),c(n),d(n)
Next
sleep
They all seem to be working.
I see that RndPCG32 needs a warmup.