MOAPRNG
Algorithm creator(s)
George Marsaglia
PB author(s)
Andrew Peskin
Description
'The Mother of all PRNGs', this is a multiply-with-carry or recursion-with-carry generator with a period/cycle length of 3 x 10^47. Passes all ENT and DIEHARD tests.
Note
Source
https://forum.powerbasic.com/forum/user-to-user-discussions/programming/20112-excellent-pseudo-random-number-generator
See also
n/a
Source Code
Download source code file moaprng.bas (Right-click -> "Save as ...")
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// DLL Name: MOA_PRNG
'// DLL Type: PowerBasic Windows 7.0
'// Platform: 32-Bit Windows: 95~98~NT~2000
'// Author: A_Peskin
'// Original Date: 12 Dec 2002 08:23
'// Copyright: Copyright © 2002
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// Description: Mother-of-All pseudo random number generator
'// This is a multiply-with-carry or
'// recursion-with-carry generator, invented by George Marsaglia
'//
'// Algorithm:
'//
'// S = 2111111111 · Xn-4 + 1492 · Xn-3 + 1776 · Xn-2 + 5115 · Xn-1 + C
'//
'// Xn = S modulo 232
'// C = floor(S / 232)
'// The last four X'es and C are stored in a buffer as 32-bit unsigned integers.
'// The intermediate S is a 64-bit unsigned integer.
'// The X'es and C are initialized to random values based on a seed.
'// They cannot all be zero.
'//
'// Cycle length is 3 x 10^47
'// This PRNG Passes All Test in ENT and in DIEHARD
'// ENT Can be found at: http://www.fourmilab.ch/random/
'// DIEHARD Can be found at: http://stat.fsu.edu/~geo/diehard.html
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// Requirements: None
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// Revision History:
'// 10 Dec 2002 ASP Initial working version.
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//~~~~~~~~~~~~~~~~~~
'// ENUMERATIONS
'//~~~~~~~~~~~~~~~~~~
'//~~~~~~~~~~~~~~~~~~~~~~~~
'// COMPILER DIRECTIVES
'//~~~~~~~~~~~~~~~~~~~~~~~~
#COMPILE DLL
#INCLUDE "WIN32API.INC"
'//~~~~~~~~~~~~~~~~~~~~~~~
'// DEFAULT CONSTANTS
'//~~~~~~~~~~~~~~~~~~~~~~~
%TRUE = 1 '// Set True Numeric Equate
%FALSE = 0 '// Set False Numeric Equate
'//~~~~~~~~~~~~~~~~~~~~~
'// ERROR CONSTANTS
'//~~~~~~~~~~~~~~~~~~~~~
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// API FUNCTION CONSTANTS
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//~~~~~~~~~~~~~~~~~~~~~~~
'// USER DEFINED TYPES
'//~~~~~~~~~~~~~~~~~~~~~~~
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// MEMBER VARIABLES : LOCAL COPY
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GLOBAL ghInstance AS DWORD
GLOBAL m_xBuff() AS EXT '// Buffer
GLOBAL m_bSeedComplete AS BYTE '// Flag indicating if Seed has been Set
GLOBAL m_xMultConst AS EXT '// Precomputed Multiplier
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// API FUNCTION DECLARATION
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// DLL INITIALIZATION~TERMINATION
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FUNCTION LIBMAIN (BYVAL hInstance AS LONG, _
BYVAL fwdReason AS LONG, _
BYVAL lpvReserved AS LONG) AS LONG
'// "When" is this Occuring
SELECT CASE fwdReason
'// Initialization
CASE %DLL_PROCESS_ATTACH
'// DLL is being loaded or attached by another process
'// Set Instance
ghInstance = hInstance
'// Set Seed has Not been Initialized
m_bSeedComplete = %FALSE
'// Precompute Multiplier Value
m_xMultConst = (1## / (65536## * 65536##))
'// Function Return
FUNCTION = 1 '// Success
'// Termination
CASE %DLL_PROCESS_DETACH
'// DLL is being unloaded or detached from the calling application
'// Function Return
FUNCTION = 1 '// Success
CASE %DLL_THREAD_ATTACH
'// DLL is being loaded or attached by another process
'// Set Instance
ghInstance = hInstance
'// Set Seed has Not been Initialized
m_bSeedComplete = %FALSE
'// Precompute Multiplier Value
m_xMultConst = (1## / (65536## * 65536##))
'// Function Return
FUNCTION = 1 '// Success
CASE %DLL_THREAD_DETACH
'// DLL is being unloaded or detached from the calling application
'// Function Return
FUNCTION = 1 '// Success
END SELECT
END FUNCTION
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// FUNCTION DECLARATIONS
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// METHOD IMPLEMENTATION
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~
FUNCTION MRnd () EXPORT AS DOUBLE
'// Returns a random number between 0 and 1:
DIM c AS EXT
'// Make Sure Seed has Been Initialized
IF ( m_bSeedComplete = %FALSE ) THEN
CALL MRandomize
END IF
'// Calculate Next Random Number
c = 2111111111## * m_xBuff(3) + _
1492## * m_xBuff(2) + _
1776## * m_xBuff(1) + _
5115## * m_xBuff(0) + m_xBuff(4)
m_xBuff(3) = m_xBuff(2)
m_xBuff(2) = m_xBuff(1)
m_xBuff(1) = m_xBuff(0)
m_xBuff(4) = INT(c)
m_xBuff(0) = c - m_xBuff(4)
m_xBuff(4) = m_xBuff(4) * m_xMultConst
'// Function Return
FUNCTION = m_xBuff(0)
END FUNCTION
SUB MRandomize (OPTIONAL BYVAL lSeed AS LONG) EXPORT
DIM uiSeedVal AS DWORD
DIM i AS WORD
'// Set Seed has Not been Initialized
m_bSeedComplete = %TRUE
'// Redimension and Initialize Buffer
REDIM m_xBuff(0?? TO 4??)
FOR i = 0?? TO 4??
m_xBuff(i) = 0##
NEXT i
'// Check if Auto Seed
IF (lSeed = 0&) THEN
uiSeedVal = TIMER
ELSE
uiSeedVal = lSeed
END IF
'// Make random numbers and put them into the buffer
FOR i = 0?? TO 4??
uiSeedVal = uiSeedVal * 29943829 - 1
m_xBuff(i) = uiSeedVal * m_xMultConst
NEXT i
'// randomize some more
FOR i = 0?? TO 18??
MRnd
NEXT i
END SUB
FUNCTION MRndINT (BYVAL lMin AS LONG, BYVAL lMax AS LONG) EXPORT AS LONG
'// Returns INTEGER RANDOM number IN desired interval:
DIM lInterval AS LONG
DIM lIntVal AS LONG
'// Calculate Interval Size
lInterval = lMax - lMin + 1&
'// Make Sure Interval Not 0
IF ( lInterval <= 0& ) THEN
FUNCTION = 0&
EXIT FUNCTION
END IF
'// Calculate Integer Portion
lIntVal = FIX(lInterval * MRnd)
'// Make Sure Not Too Large
IF ( lIntVal > lInterval ) THEN
lIntVal = lInterval - 1&
END IF
'// Return Integer Number
FUNCTION = lMin + lIntVal
END FUNCTION
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// PRIVATE PROCEDURES
'//~~~~~~~~~~~~~~~~~~~~~~~~~~~