Most generators have just one sequence. All of FreeBASIC's generators are single sequenced. Most of my implementations have just one sequence, except for PCG32II which has 2^63 sequences. The MsWsII package comes with 16,384 sequences. More to the point, it comes with 16,384 constants which are used in the generator's engines; one for the 32-bit engine and two for the 64-bit engine. Yes, MsWsII has two engines. MsWs uses Widynski's Version 3. MsWsII uses Widynski's Version 4, published three weeks ago, when the 64-bit engine was introduced. The 32-bit engine remains as was. The constants are in a bi file, Mysvalues.bi, loaded by MsWsII.bas. I did that rather than have the constants hard-wired into MsWsII.bas so that you can crop the 16384 if needs be.
Rather than post the 16384 constants, here is a link to a zipped file which contains Mysvaluesbi, which is 340KB unzipped. 340KB may seem large, but it gets loaded into MsWsII.bas from a hard drive in the blink of an eye. MsWsII.zip is a zip of the help file.
Mysvalues.zip
MsWsIIHelp.zip
MsWsII.bas is small – just less than 350 lines of code.
The Help file is small but covers all aspects of WsMsII. In fact, it is only 32.9KB. FB's Help file is 2.19MB.
Most of us find reading Help files tedious, but MsWsII.chm is essential reading if you want to get the most out of MsWsII. Some of you may find the MsWsII source code intimidating. If it is any consolation, so do I and I wrote it and why MsWsII.chm was written. Fortunately I don't have to read the Help file.
I am fairy confident that MsWsII is bug free. I had very few during development. I am not into bugs – I find that they slow me down.
If, like speedfixer, you find fbprng.bi a bit of a pain, then just ignore it and use MsWsII.
So with all the PRNG implementations that I have been involved in, which one will I use? Well, I will use MsWsII - I don't have a compelling reason not to. OK, I may have one or two procedures in other implementations that may be faster, but they are not significantly faster, and I doubt that their use will have any influence on my applications or yours. MsWs Version 4 is a gem and well done Bernard Widynski.
Getting started:
1) Download Mysvalues.zip and unzip.
2) Put MsWsII.bas and Msvalues.bi into your application folder.
3) At the head of your application type #Include Once "MsWsII.bas"
On running your application, MsWsII.bas will load Mysvalues.bi and the generator will be available for use.
4) Download MsWsII.zip and unzip. You now have the Help file.
Many topics in the Help file have code snippets. These are meant to be run. You will get up to speed on MsWsII much quicker by running them.
MsWsII.bas
Code: Select all
' MsWsII.bas Version 1.6
#Include Once "Mysvalues.bi"
#Include Once "file.bi"
#define dodrange(f,l) Int(Rnd*(((l)+1)-(f))+(f)) ' By dodicat
#Ifndef Uint32
#define Uint32 UInteger<32>
#EndIf
#Ifndef Uint16
#define Uint16 UInteger<16>
#EndIf
#Ifndef Uint64
#define Uint64 UInteger<64>
#EndIf
#Ifndef Int32
#define Int32 Integer<32>
#EndIf
#Macro Engine1
Dim As Uint32 Engine1Result
This.Seed *= This.Seed : This.Sequence += This.svalue(0) : This.Seed += This.Sequence
This.Seed = ( This.Seed Shr 32 ) Or ( This.Seed Shl 32 )
Engine1Result = This.Seed
#EndMacro
#Macro Engine2
Dim As Uint64 Engine2Result
This.Seed1 *= This.Seed1
This.Sequence1 += This.svalue(1)
This.Seed1 += This.Sequence1
Engine2Result = This.Seed1
This.Seed1 = ( This.Seed1 Shr 32 ) Or ( This.Seed1 Shl 32 )
This.Seed2 *= This.Seed2
This.Sequence2 += This.svalue(2)
This.Seed2 += This.Sequence2
This.Seed2 = ( This.Seed2 Shr 32 ) Or ( This.Seed2 Shl 32 )
Engine2Result Xor= This.Seed2
#EndMacro
Type MsWsParams
Public:
Declare Constructor( As Boolean = FALSE )
Declare Sub Setup()
Declare Sub Reboot()
Declare Sub Initialize()
Declare Function rand() As Uint32
Declare Function rand64() As Uint64
Declare Function randse() As Double
Declare Function randd() As Double
Declare Function range OverLoad ( First As Double, Last As Double ) As Double
Declare Function range OverLoad ( First As Int32, Last As Int32 ) As Int32
Declare Sub GetEngine1Snapshot()
Declare Sub SetEngine1SnapShot()
Declare Sub GetEngine2Snapshot()
Declare Sub SetEngine2SnapShot()
Declare Sub RestoreEngine1InitialState()
Declare Sub RestoreEngine2InitialState()
Declare Sub RestoreAllInitialState()
Declare Sub SaveMetrics( As String )
Declare Sub LoadMetrics( As String )
Declare Function Gauss() As Double
'Declare Sub DumpState() ' Used during development
Private:
Declare Sub GetInitialState()
Declare Sub ClearDecks()
As Uint64 SnapStateVector(0 To 5)
As Uint64 InitialState(0 To 5)
' State vectors
Seed As Uint64
Sequence As Uint64
Seed1 As Uint64
Seed2 As Uint64
Sequence1 As Uint64
Sequence2 As Uint64
As Uint64 svalue(0 To 2)
Cache As Boolean
End Type
' ***********************************
' Seeding functions
Function HammingSeed64() As Uint64
Dim As Uint32 tscSeed0, tscSeed1, numBits
Dim As Uint64 Seed, CopySeed
While Not ((numBits > 30) And (numBits < 34)) ' Gd quality entropy - we don't need exactly 32
Asm
rdtsc
mov ecx, eax
bswap eax ' fast moving to upper bits
mov Dword Ptr [tscSeed0], eax
Add ecx, 1073741824 ' A quarter of a spin
bswap ecx ' fast moving to upper bits
mov Dword Ptr [tscSeed1], ecx
End Asm
Seed = (Cast( Uint64, tscSeed0 ) Shl 32) Or Cast( Uint64, tscSeed1 )
CopySeed = Seed : numBits = 0
While CopySeed <> 0
CopySeed = CopySeed And CopySeed - 1
numBits += 1
Wend
Wend
Return Seed
End Function
Sub ShuffleUint64( ByRef x As Uint64 )
Randomize , 5 ' For dodrange
Union localUDT
As Uint64 ul
As Byte b(7)
End Union
Dim As localUDT l
l.ul = x
For i As Uint32 = 0 To 6
Swap l.b(i), l.b(dodrange(i, 7))
Next
x = l.ul ' <- without this x will not change
' Restore FB's default
Randomize , 3
End Sub
' ***********************************
' 32-bit random number
Function MsWsParams.rand() As Uint32
Engine1
Return Engine1Result
End Function
' 64-bit random number
Function MsWsParams.rand64() As Uint64
Engine2
Return Engine2Result
End Function
' 32-bit granularity [0,1)
Private Function MsWsParams.randse() As Double
Engine1
Return Engine1Result/2^32
End Function
' 53-bit granularity [0,1)
Private Function MsWsParams.randd() As Double
Engine2
Return (Engine2Result Shr 11)/2^53
End Function
' Floating point range
Private Function MsWsParams.range( First As Double, Last As Double ) As Double
Engine1
Function = Engine1Result/2^32 * ( Last - First ) + First
End Function
' Integral range - Int32 (Long)
Private Function MsWsParams.range(First As Int32, Last As Int32) As Int32
Engine1
Return CLng( Engine1Result Mod (Last-First+1)) + First
End Function
' Normal distribution
Private Function MsWsParams.Gauss As Double
Static As Double u1, u2, x1, x2, w
If This.Cache = TRUE Then
This.Cache = FALSE
Function = u2
Else
Do
x1 = This.randse
x2 = This.randse
w = x1 * x1 + x2 * x2
Loop While w >= 1
w = Sqr( -2 * Log(w)/w )
u1 = x1 * w
u2 = x2 * w
This.Cache = TRUE
Function = u1
End If
End Function
Private Sub MsWsParams.GetEngine1Snapshot( )
If This.Cache Then This.Gauss
snapStateVector(0) = Seed
snapStateVector(3) = Sequence
End Sub
Private Sub MsWsParams.SetEngine1Snapshot( )
This.Cache = FALSE
If snapStateVector(0)=0 AndAlso snapStateVector(3)=0 Then
' ie a GetSnapshot has not been executed so use InitialState()
Seed = InitialState(0)
Sequence = InitialState(3)
Else
Seed = SnapStateVector(0)
Sequence = SnapStateVector(3)
End If
End Sub
Private Sub MsWsParams.GetEngine2Snapshot( )
snapStateVector(1) = Seed1
snapStateVector(2) = Seed2
snapStateVector(4) = Sequence1
snapStateVector(5) = Sequence2
End Sub
Private Sub MsWsParams.SetEngine2Snapshot( )
If snapStateVector(1)=0 AndAlso snapStateVector(2)=0 AndAlso snapStateVector(4)=0 AndAlso snapStateVector(5)=0 Then
Seed1 = InitialState(1)
Seed2 = InitialState(2)
Sequence1 = InitialState(4)
Sequence2 = InitialState(5)
Else
Seed1 = SnapStateVector(1)
Seed2 = SnapStateVector(2)
Sequence1 = SnapStateVector(4)
Sequence2 = SnapStateVector(5)
End If
End Sub
Sub MsWsParams.GetInitialState( )
InitialState(0) = Seed
InitialState(1) = Seed1
InitialState(2) = Seed2
InitialState(3) = Sequence
InitialState(4) = Sequence1
InitialState(5) = Sequence2
End Sub
Private Sub MsWsParams.RestoreEngine1InitialState( )
This.Cache = FALSE
Seed = InitialState(0)
Sequence = InitialState(3)
End Sub
Private Sub MsWsParams.RestoreEngine2InitialState( )
Seed1 = InitialState(1)
Seed2 = InitialState(2)
Sequence1 = InitialState(4)
Sequence2 = InitialState(5)
End Sub
Private Sub MsWsParams.RestoreAllInitialState()
RestoreEngine1InitialState
RestoreEngine2InitialState
End Sub
' Random seeding for all
Sub MsWsParams.Initialize( )
' For Engine1
Seed = HammingSeed64 : ShuffleUint64( Seed )
' For Engine2
Seed1 = HammingSeed64 : ShuffleUint64( Seed1 )
Seed2 = HammingSeed64 : ShuffleUint64( Seed2 )
' For Engine1
Sequence = HammingSeed64 : ShuffleUint64( Sequence )
' For Engine2
Sequence1 = HammingSeed64 : ShuffleUint64( Sequence1 )
Sequence2 = HammingSeed64 : ShuffleUint64( Sequence2 )
End Sub
Constructor MsWsParams( SkipSetup As Boolean = FALSE )
If SkipSetUp = FALSE Then Setup
End Constructor
Sub MsWsParams.Setup()
Dim As Uint32 ubnd
Randomize , 5 ' For dodrange
ubnd = UBound( Mysvalues )
Swap Mysvalues( 0 ), Mysvalues( dodrange( 0, ubnd ) )
Swap Mysvalues( 1 ), Mysvalues( dodrange( 1, ubnd ) )
Swap Mysvalues( 2 ),Mysvalues( dodrange( 2, ubnd ) )
This.svalue(0) = Mysvalues( 0 )
This.svalue(1) = Mysvalues( 1 )
This.svalue(2) = Mysvalues( 2 )
Initialize
GetInitialState
' Restore FB's default
Randomize , 3
End Sub
Private Sub MsWsParams.ClearDecks
Erase This.SnapStateVector
This.Cache = FALSE
End Sub
Private Sub MsWsParams.Reboot
Dim As Uint32 ubnd, first, Second, third
Static count As Uint16 = 3
Randomize , 5 ' For dodrange
ubnd = UBound( Mysvalues )
Swap Mysvalues( count ), Mysvalues( dodrange( count, ubnd ) )
Swap Mysvalues( count + 1 ), Mysvalues( dodrange( count + 1, ubnd ) )
Swap Mysvalues( count + 2 ),Mysvalues( dodrange( count + 2, ubnd ) )
This.svalue(0) = Mysvalues( count )
This.svalue(1) = Mysvalues( count + 1 )
This.svalue(2) = Mysvalues( count + 2 )
count += 3
ClearDecks
Initialize
GetInitialState
' Restore FB's default
Randomize , 3
End Sub
Private Sub MsWsParams.SaveMetrics( filename As String )
Dim As Long f = FreeFile
If FileExists( filename ) Then Kill ( filename )
Open filename For Binary As #f
Put #f, , this ' by dodicat
Close #f
End Sub
Private Sub MsWsParams.LoadMetrics( filename As String )
Dim As Long f = FreeFile
Open filename For Binary As #f
Get #f, , this ' by dodicat
Close #f
End Sub
' Used during development
'Private Sub MsWsParams.DumpState
' Print Hex(This.Seed,16);" ";Bin(This.Seed,64)
' Print Hex(This.Seed1,16);" ";Bin(This.Seed1,64)
' Print Hex(This.Seed2,16);" ";Bin(This.Seed2,64)
' Print Hex(This.Sequence,16);" ";Bin(This.Sequence,64)
' Print Hex(This.Sequence1,16);" ";Bin(This.Sequence1,64)
' Print Hex(This.Sequence2,16);" ";Bin(This.Sequence2,64)
'End Sub
Dim Shared As MsWsParams msws
#undef Rnd
#define Rnd msws.randse
#define RndD msws.randd
#define Range_ msws.range