Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Rnd2 revisited

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Rnd2 revisited

    I modified David Robert's comprehensive Rnd2 function posted earlier here in a attempt to make it 1) as exactly like RND as possible, 2) as fast as possible, while maintaining 3) its randomness no matter how initiated & used. This function can replace PowerBasic RND function entirely I believe, and has almost the same syntax.

    Here is example code:
    Code:
    'Example code for Rnd2(), a function substitute for RND and RANDOMIZE.
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "trueRandom.inc"
    
    DECLARE FUNCTION QueryPerformanceFrequency LIB "KERNEL32.DLL" ALIAS "QueryPerformanceFrequency" (lpFrequency AS QUAD) AS LONG
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' System Timer Macros
    GLOBAL qFreq, qOverhead, qStart, qStop AS QUAD
    GLOBAL f AS STRING
    
    MACRO InitializeTimer
      f = "#####.##"
      QueryPerformanceFrequency qFreq
      QueryPerformanceCounter qStart ' Intel suggestion. First use may be suspect
      QueryPerformanceCounter qStart ' So, wack it twice <smile>
      QueryPerformanceCounter qStop
      qOverhead = qStop - qStart     ' Relatively small
    END MACRO
    
    MACRO StartTimer = QueryPerformanceCounter qStart
    MACRO StopTimer = QueryPerformanceCounter qStop
    
    MACRO sTimeTaken = USING$(f,(qStop - qStart - qOverhead)*1000/qFreq) + "ms"
    MACRO nTimeTaken = (qStop - qStart - qOverhead)*1000/qFreq
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    FUNCTION PBMAIN( ) AS LONG
    LOCAL i, j AS LONG, x AS EXT
    
      InitializeTimer
    
    #IF %DEF(%PB_CC32)
    
      PRINT "No chosen sequence":PRINT
      FOR i = 1 TO 5
        PRINT Rnd2
      NEXT
      PRINT
     WAITKEY$
      PRINT "DefaultSequence":PRINT
      DefaultSequence
      FOR i = 1 TO 5
        PRINT Rnd2
      NEXT
      PRINT
      PRINT:PRINT "**********":PRINT
     WAITKEY$
    
      PRINT "Rnd2(-1234567890)":PRINT
      PRINT Rnd2(-1234567890)
      FOR i = 1 TO 5
        PRINT Rnd2
      NEXT
      PRINT
     WAITKEY$
      PRINT "Rnd2(-1234567891)":PRINT
      PRINT Rnd2(-1234567891)
      FOR i = 1 TO 5
        PRINT Rnd2
      NEXT
      PRINT
     WAITKEY$
      PRINT "RepeatLastSequence":PRINT
      RepeatLastSequence
      FOR i = 1 TO 6
        PRINT Rnd2
      NEXT
      PRINT:PRINT "**********":PRINT
     WAITKEY$
    
      PRINT "Randomise":PRINT
      Randomise
      FOR i = 1 TO 5
        PRINT Rnd2
      NEXT
      PRINT
     WAITKEY$
      PRINT "RepeatLastSequence":PRINT
      RepeatLastSequence
      FOR i = 1 TO 5
        PRINT Rnd2
      NEXT
      PRINT:PRINT "**********":PRINT
     WAITKEY$
    
      PRINT "Randomise, ToggleScope":PRINT
      Randomise
      ToggleScope
      FOR i = 1 TO 10
        PRINT Rnd2
      NEXT
      PRINT
     WAITKEY$
      PRINT "RepeatLastSequence":PRINT
      RepeatLastSequence
      FOR i = 1 TO 10
        PRINT Rnd2
      NEXT
      PRINT:PRINT "**********":PRINT
     WAITKEY$
      ToggleScope
    
      PRINT "Repeat last number generated ";RepeatLastRnd2
      PRINT:PRINT "**********":PRINT
     WAITKEY$
    
      PRINT "Choose from range 0 to 255"
      FOR j = 1 TO 21
        FOR i = 1 TO 19
          PRINT USING$("### ",Rnd2(0, 255));
        NEXT
        PRINT
      NEXT
      PRINT "**********"
     WAITKEY$
    
      PRINT "Bookmark/GotoBookmark example":PRINT
      Randomise
      FOR i = 1 TO 5
        PRINT Rnd2
      NEXT
      PRINT
     WAITKEY$
      PRINT "Bookmark":PRINT
      Bookmark
      FOR i = 1 TO 5
        PRINT Rnd2
      NEXT
      PRINT
     WAITKEY$
      PRINT "GotoBookmark":PRINT
      GotoBookmark
      FOR i = 1 TO 5
        PRINT Rnd2
      NEXT
      PRINT:PRINT "**********":PRINT
     WAITKEY$
    
      PRINT "TrueRandom Bookmark/GotoBookmark example":PRINT
      Randomise
      FOR i = 1 TO 5
        TrueRandom
        PRINT Rnd2
      NEXT
      PRINT
     WAITKEY$
      PRINT "Bookmark":PRINT
      Bookmark
      FOR i = 1 TO 5
        TrueRandom
        PRINT Rnd2
      NEXT
      PRINT
     WAITKEY$
      PRINT "GotoBookmark":PRINT
      GotoBookmark
      FOR i = 1 TO 5
        TrueRandom
        PRINT Rnd2
      NEXT
      PRINT "As expected, no match at all. TrueRandom is truly oneùoff "
      PRINT:PRINT "**********":PRINT
     WAITKEY$
    
      PRINT "TrueRandom card shuffle": PRINT
      PRINT "start order: ";
      DIM card(1 TO 52) AS LONG
      FOR i = 1 TO 52
         card(i) = i
         PRINT STR$(i);
      NEXT
      PRINT
     WAITKEY$
    
      PRINT:PRINT "shuff order: ";
      FOR i = 1 TO 52
         TrueRandom
         SWAP card(i), card(Rnd2(i, 52))
         PRINT STR$(card(i));
      NEXT
    
    '-----------------------------------------------------------------------
    ' for j = 1 to 10
    '  print
    '  waitkey$
    '  PRINT "shuff order: ";
    '  FOR i = 1 TO 52
    '     TrueRandom                       'you CAN shuffle more than one time thru the FOR-NEXT loop, but one time
    '     SWAP card(i), card(Rnd2(i, 52))  'is statistically just as random as 2, or 10, or 100, or 1000... :)
    '     PRINT STR$(card(i));
    '  NEXT
    ' next
    '-----------------------------------------------------------------------
    
      PRINT:PRINT "**********":PRINT
     WAITKEY$
    
      PRINT "10,000,000 iterations":PRINT
    
      StartTimer
        FOR i = 1 TO 10000000
          x = RND
        NEXT i
      StopTimer
    
      PRINT "RND:        ";sTimeTaken
    
      Randomise
      StartTimer
        FOR i = 1 TO 10000000
          x = Rnd2
        NEXT i
      StopTimer
    
      PRINT "Rnd2 [0,1): ";sTimeTaken
    
      RepeatLastSequence
      ToggleScope
      StartTimer
        FOR i = 1 TO 10000000
          x = Rnd2
        NEXT i
      StopTimer
    
      PRINT "Rnd2 (-1,1):";sTimeTaken
      ToggleScope
    
      PRINT:PRINT "*****Integer Mode*****"
    
      StartTimer
        FOR i = 1 TO 10000000
          j = RND(1, 52)
        NEXT i
      StopTimer
    
      PRINT "RND(1, 52): ";sTimeTaken
    
      StartTimer
        FOR i = 1 TO 10000000
          j = Rnd2(1, 52)
        NEXT i
      StopTimer
    
      PRINT "Rnd2(1, 52):";sTimeTaken
      StartTimer
        FOR i = 1 TO 10000000
          j = RND(-2147483648, 2147483647)
        NEXT i
      StopTimer
    
      PRINT "RND(-2147483648, 2147483647): ";sTimeTaken
    
      StartTimer
        FOR i = 1 TO 10000000
          j = Rnd2Long
        NEXT i
      StopTimer
    
      PRINT "Rnd2(-2147483648, 2147483647):";sTimeTaken
    
     WAITKEY$
    
     '--------------------------------------------------------------------
     '--------------------------------------------------------------------
    #ELSE           'pb win32
      LOCAL pStr AS STRING
       pStr = pStr & "No chosen sequence" & $CRLF
      FOR i = 1 TO 5
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
      pStr = pStr & $CRLF & "DefaultSequence" & $CRLF
      DefaultSequence
      FOR i = 1 TO 5
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
           :pStr = pStr & $CRLF & "**********" & $CRLF
     ? pStr,,"Default"
     pStr = ""
    
      pStr = pStr & "Rnd2(-1234567890)" & $CRLF
      pStr = pStr & STR$(Rnd2(-1234567890)) & $CRLF
      FOR i = 1 TO 5
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
    
      pStr = pStr & $CRLF & "Rnd2(-1234567891)" & $CRLF
      pStr = pStr & STR$(Rnd2(-1234567891)) & $CRLF
      FOR i = 1 TO 5
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
    
      pStr = pStr & $CRLF & "RepeatLastSequence" & $CRLF
      RepeatLastSequence
      FOR i = 1 TO 6
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
           :pStr = pStr & $CRLF & "**********" & $CRLF
     ? pStr,,"Single Neg LONG Integer"
     pStr = ""
    
      pStr = pStr & "Randomise" & $CRLF
      Randomise
      FOR i = 1 TO 5
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
    
      pStr = pStr & $CRLF & "RepeatLastSequence" & $CRLF
      RepeatLastSequence
      FOR i = 1 TO 5
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
           :pStr = pStr & $CRLF & "**********" & $CRLF
     ? pStr,, "Randomise/TrueRandom/Rnd2(1)"
     pStr = ""
    
      pStr = pStr & "Randomise, ToggleScope" & $CRLF
      Randomise
      ToggleScope
      FOR i = 1 TO 10
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
    
      pStr = pStr & $CRLF & "RepeatLastSequence" & $CRLF
      RepeatLastSequence
      FOR i = 1 TO 10
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
           :pStr = pStr & $CRLF & "**********" & $CRLF  & $CRLF
     ? pStr,, "ToggleScope"
      ToggleScope
    
    
      pStr = pStr & "Repeat last number generated " & $CRLF & STR$(RepeatLastRnd2)
        '  :pStr = pStr & "**********"
     ? pStr,, "Last # Generated"
     pStr = ""
    
      pStr = pStr & "Choose from range 0 to 255:" & $CRLF
      FOR j = 1 TO 21
        FOR i = 1 TO 19
          pStr = pStr & USING$("### ",Rnd2(0, 255))
        NEXT
        pStr = pStr & $CRLF
      NEXT
      pStr = pStr & $CRLF & "**********" & $CRLF
     ? pStr,, "Range 0 thru 255"
     pStr = ""
    
      pStr = pStr & "Bookmark/GotoBookmark example" & $CRLF
      Randomise
      FOR i = 1 TO 5
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
    
      pStr = pStr & $CRLF & "Bookmark" & $CRLF
      Bookmark
      FOR i = 1 TO 5
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
    
      pStr = pStr & $CRLF & "GotoBookmark" & $CRLF
      GotoBookmark
      FOR i = 1 TO 5
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
           :pStr = pStr & $CRLF & "**********" & $CRLF
     ? pStr,, "Bookmark"
     pStr = ""
    
      pStr = pStr & "TrueRandom Bookmark/GotoBookmark example" & $CRLF
      Randomise
      FOR i = 1 TO 5
        TrueRandom
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
    
      pStr = pStr & $CRLF & "Bookmark" & $CRLF
      Bookmark
      FOR i = 1 TO 5
        TrueRandom
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
    
    
      pStr = pStr & $CRLF & "GotoBookmark" & $CRLF
      GotoBookmark
      FOR i = 1 TO 5
        TrueRandom
        pStr = pStr & STR$(Rnd2()) & $CRLF
      NEXT
      pStr = pStr & "As expected, no match at all. TrueRandom is truly one·off" & $CRLF
           :pStr = pStr & $CRLF & "**********" & $CRLF
     ? pStr,,"TrueRandom One·Off Only"
     pStr = ""
    '                      TrueRandom
      pStr = pStr & "TrueRandom card shuffle" & $CRLF
      pStr = pStr & "start order: "
      DIM card(1 TO 52) AS LONG
      FOR i = 1 TO 52
         card(i) = i
         pStr = pStr & STR$(i)
      NEXT
    
    ' ? pStr,,"Card Shuffle"
      pStr = pStr & $CRLF & $CRLF
           :pStr = pStr & "shuff order: "
      FOR i = 1 TO 52
         TrueRandom
         SWAP card(i), card(Rnd2(i, 52))
         pStr = pStr & STR$(card(i))
      NEXT
    '-----------------------------------------------------------------------
    ' for j = 1 to 10
    '  ? pStr,,"TrueRandom Card Shuffle"
    '  pStr = "shuff order: "
    '  FOR i = 1 TO 52                  'you CAN shuffle more than one time thru the FOR-NEXT loop, but one time
    '     TrueRandom                    'is statistically just as random as 2, or 10, or 100, or 1000... :)
    '     SWAP card(i), card(Rnd2(i, 52))
    '     pStr = pStr & STR$(card(i))
    '  NEXT
    ' next
    '-----------------------------------------------------------------------
      pStr = pStr & $CRLF
           :pStr = pStr & $CRLF & "**********" & $CRLF
     ? pStr,,"TrueRandom Card Shuffle"
     pStr = ""
    
      ? "Timing test is next for 10,000,000 iterations...",, "Timing"
      pStr = pStr & "10,000,000 iterations" & $CRLF
    
      StartTimer
        FOR i = 1 TO 10000000
          x = RND
        NEXT i
      StopTimer
    
      pStr = pStr & "RND:          " & sTimeTaken & $CRLF
    
      Randomise
      StartTimer
        FOR i = 1 TO 10000000
          x = Rnd2
        NEXT i
      StopTimer
    
      pStr = pStr & "Rnd2 [0,1): " & sTimeTaken & $CRLF
    
      RepeatLastSequence
      ToggleScope
      StartTimer
        FOR i = 1 TO 10000000
          x = Rnd2
        NEXT i
      StopTimer
    
      pStr = pStr & "Rnd2 (-1,1):" & sTimeTaken & $CRLF & $CRLF
      ToggleScope
    
           :pStr = pStr & "*****Integer Mode*****" & $CRLF
    
      StartTimer
        FOR i = 1 TO 10000000
          j = RND(1, 52)
        NEXT i
      StopTimer
    
      pStr = pStr & "RND(1, 52): " & sTimeTaken & $CRLF
    
      StartTimer
        FOR i = 1 TO 10000000
          j = Rnd2(1, 52)
        NEXT i
      StopTimer
    
      pStr = pStr & "Rnd2(1, 52):" & sTimeTaken & $CRLF
      StartTimer
        FOR i = 1 TO 10000000
          j = RND(-2147483648, 2147483647)
        NEXT i
      StopTimer
    
      pStr = pStr & "RND(-2147483648, 2147483647): " & sTimeTaken & $CRLF
    
      StartTimer
        FOR i = 1 TO 10000000
          j = Rnd2Long
        NEXT i
      StopTimer
    
      pStr = pStr & "Rnd2(-2147483648, 2147483647):" & sTimeTaken & $CRLF
      ? pStr,,"Timing"
    
    #ENDIF
    
    END FUNCTION
    Here is the include file called TrueRandom.inc
    Code:
    'TrueRandom.inc used for Rnd2() function and macros
    DECLARE FUNCTION QueryPerformanceCounter LIB "KERNEL32.DLL" ALIAS "QueryPerformanceCounter" (lpPerformanceCount AS QUAD) AS LONG
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' Rnd2 Macros
    MACRO Randomise  = Rnd2(1)                        'with an "s" to distinguish from RANDOMIZE
    MACRO TrueRandom = Rnd2(1)                        'a fun way to think of it :D
    MACRO Rnd2Long   = Rnd2(-2147483648, 2147483647)  'commonly used full LONG range
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' Rnd2 Additional Macros
    MACRO RepeatLastRnd2 = Rnd2(0)
    MACRO ToggleScope = Rnd2(2)
    MACRO DefaultSequence = Rnd2(3)
    MACRO RepeatLastSequence = Rnd2(4)
    MACRO GotoBookmark = Rnd2(4)
    MACRO Bookmark = Rnd2(5)
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    FUNCTION Rnd2( OPT One AS LONG, Two AS LONG ) AS EXT
    '-----------------------------------------------------------------------------------------
      'I modified this function in an attempt to enhance Dave Robert's comprehensive Rnd2 posted earlier here by making it
      '1) as exactly like RND as possible, 2) as fast as possible, while maintaining 3) random no matter how initiated & used.
      'This function can replace PowerBasic RND function entirely I believe, and has almost the same syntax.
      'A major difference between Rnd2 and RND is that Rnd2 has TrueRandom© ;) initialization. Say what? Well read on.
      'What are TrueRandom numbers?:
      'Some say true randomness doesn't exist, but eg. radioactive decay makes a strong case for true randomness. So Rnd2
      'uses the natural radioactive decay of gallium arsenide isotopes in your CPU to create TrueRandom numbers.
      'Hey, just kidding. TrueRandom numbers actually get their randomness from slight timing variations that occur during
      'eg. memory fetches, context switching, interrupt calls, hard drive head seeks--really anything that takes slightly
      'varying amounts of time on your computer, which is actually...everything! TrueRandom then multiplies these small
      'differences HUGELY, and also accumulates them so they compound one another. This "time static" let's call it, works
      'its magic and voila!, statistically random real-time numbers. The technique to code for TrueRandom numbers is shown
      'in the dice example below (see "1 argument").
      'Floating point mode:
      'Rnd2 returns a random value that is less than 1, but greater than or equal to 0. Numbers generated by Rnd2 CAN
      'be "really" random, or can apply a pseudo-random transformation algorithm to a starting ("seed") value. Given the
      'same seed, Rnd2 always produces the same sequence of "random" numbers. The random value is calculated
      'internally as an extended precision representation so it can be readily used in any situation. Rnd2 has a period of
      'at least 2^61, and if you re-seed it every few hundred years, up to ~2^70. That's 200 billion times larger than
      'RND's period of ~2^32. All 18 digits of Rnd2 are significant.
      'Integer Range mode:
      'Rnd2(a, b) returns an extended value equal to a Long-integer in the range of a to b inclusive.
      'a and b can each be a numeric literal or a numeric expression that evaluates within the range of a Long-integer
      '(-2,147,483,648 to 2,147,483,647). The fastest mode of Rnd2 is Rnd2(-2147483648, 2147483647) which is equal to
      'the MACRO Rnd2Long for convenience. All digits/bytes/bits in integer mode are significant.
      'Special effects mode:
      'When used with a single LONG numeric expression argument, the value returned by Rnd2 depends on the optional LONG
      'numeric value you supply as the argument, as follows:
      'No argument: Rnd2 generates the next number in sequence based on the initial seed value.
      '0 argument : Rnd2 repeats the last number generated.
      '- argument : negative argument causes the random number generator to be re-seeded and returns the first value in the
      '             new sequence. Subsequent uses of Rnd2 with no argument continues the new sequence.
      '             Different neg LONG arguments guarantee non-duplicate sequences for each integer -1 thru -2147483648
      '             so you can select your own repeatable sequences from the 2Gig available. This gives a similar
      '             functionality to the PB statement "RANDOMIZE number" but without dupe sequences.
      'o-o--o-o--o The following arguments 1 thru 5 are special Rnd2 effects o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o
      '1 argument : re-seeds the generator in a "truly random" way so its next number will be eg. like really throwing dice.
      '             More calls with no argument use the internal pseudo-random algorithm to continue the series, HOWEVER,
      '             unlike RND, you can call Rnd2(1) aka. Randomise/TrueRandom over and over at will to keep generating real
      '             random numbers. For example:
      '               DO: Rnd2(1): ? STR$(Rnd2(1, 6)): Rnd2(1): ? STR$(Rnd2(1, 6)): LOOP
      '               or its equivalent:
      '               DO: Randomise: ? STR$(Rnd2(1, 6)): Randomise: ? STR$(Rnd2(1, 6)): LOOP
      '               or also equivalent:
      '               DO: TrueRandom: ? STR$(Rnd2(1, 6)): TrueRandom: ? STR$(Rnd2(1, 6)): LOOP
      '             is effectively just like rolling real dice in real time with no dependency on any pseudo-random algorithm!
      '             Actually, real rolled dice would likely have to be manufactured with ultra precision to statistically
      '             match the distribution of the above code. :o) Rnd2(1) uses ~2500 tix per call.
      '2 argument : Toggles Rnd2 to return a random value that is greater than -1 and less then 1, represented (-1,1).
      '             Next use toggles back to less than 1, but greater than or equal to 0, ie. [0,1).
      '3 argument : Rnd2 returns its default sequence.
      '4 argument : repeat last sequence or bookmarked sequence.
      '5 argument : bookmark the position in current sequence.
      '>5 argument: Rnd2 generates the next number in sequence based on the initial seed value.
      'o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o--o-o
      'Do not use 0, 2 thru 5, or negative value arguments in special effects mode unless you are looking for the special
      'effects those argument values produce. And remember Rnd2(1) uses ~2500 tix doing its tuff task.
      'The random number generator can be reset back to the default seed using the following statement: Rnd2(3)
      'Speed:
      'Try as we might to make it faster, in PB9, Rnd2 with no arguments is ~10% slower in speed than RND. But take heart,
      'because Rnd2(-2147483648, 2147483647) is ~110% faster! Interestingly, in PB8/CC4 Rnd2 no arg. is ~8% faster than RND.
      'Reasons to use Rnd2:
      '1)Will likely never repeat a sequence even if run for years--hundreds of years. Has a big period.
      '2)Integer mode is much faster.
      '3)Works almost just like RND so quick learning curve.
      '4)Can use TrueRandom/Randomise/Rnd(1) whenever the heck fire you please, eg. to make TrueRandom numbers. Rnd2 is
      '  very forgiving, so no matter what you do (almost), you are going to get the fine random sequences you imagined.
      '5)Can return +/- EXT randoms using Rnd2(2)/ToggleScope to switch it on/off.
      '6)All digits are statistically random; they pass all known tests for randomness.
    '-----------------------------------------------------------------------------------------
    #REGISTER NONE
    STATIC oneTime, rndL AS LONG, eq AS QUAD
    STATIC storeState AS STRING * 12
    STATIC mwcSoph AS DWORD, rndE AS EXT
    STATIC mwcRandom, mwcCarry, TogScope AS LONG  'mwc prefix means "multiply with carry" random generator based on theory
                                                  'by George Marsaglia and is the fastest generator known to man. A man. Me. ;)
      !lea eax, two
      !mov ecx, [eax]
      !cmp ecx, 0
      !jne twoParams      ;if optional parameter 'two' passed, belt down to integer Rnd2 code section
      !lea eax, one
      !mov ecx, [eax]
      !cmp ecx, 0
      !je noParams        ;if no params, boogie down to noParams code
    
      'we got here so there must be 1 parameter
            SELECT CASE AS LONG One
    
              CASE 1          ' Randomise. tot possible unique sequences = &hffffffff * &hedffffff * 384
                              ' which = 6.6 * 10^21. This excess of initial sequences allows you to
                              ' freely use Randomise (aka. Rnd2(1)) at will to give TrueRandom numbers.
                 oneTime = 1
                 queryPerformanceCounter eq
                 !push ebx
                 !mov ecx, eq            ;single's 4 bytes are LO bytes of eq
                 !dw &h310f              ;time stamp counter to multiply w/ queryPerformanceCounter
                 !mul ecx                ;scramble time stamp counter and tickCounter together
                 !mov ecx, 384           ;384 possible sophie-germain multipliers
                 !rol eax, 1             ;lowest bit will be even 3 of 4 times so rotate to make it 50-50 even/odd
                 !mov edx, 0
                 !div ecx                ;random remainder (MOD 384) in edx now
                 !lea eax, multiplier    ;codeptr to 384 multipliers
                 !mov ecx, [eax+edx*4]   ;got rnd soph germain multiplier now
                 !mov mwcSoph, ecx       ;save it
                 !cpuid
                 !dw &h310f              ;time stamp counter To vary mwcRandom
                 !add ebx, eax           ;vary mwcRandom (ebx)
                 !mov mwcRandom, ebx     ;save. Now make sure mwcCarry <> mwcSoph(from above) - 1 or 0.
                '---------------------
                 !cmp mwcCarry, 0
                 !ja short mwcCarNot0
                 !mov ebx, eq            ;only LO bytes of eq used.
                 !mov eax, &h72C91728    ;just any medium size number you want
                 !add eax, ebx           ;add in the performance counter to randomize it
                 !adc eax, &h1234abcd    ;might = 0 after add, so if there's a carry, add a constant to be sure it's <> 0
                 !mov mwcCarry, eax      ;4 billion+ carrys now possible
                mwcCarNot0:
                 !mov ecx, mwcSoph
                 !sub ecx, 1             ;mwcSoph - 1
                 !cmp mwcCarry, ecx      ;is carry >= mwcSoph - 1 ?
                 !jb  short mwcAllOk     ;if not, we're done
                 !and mwcCarry, &h7fffffff ;make it less than mwcSoph - 1
                mwcAllOk:
                 !pop ebx
                 GOSUB sRandomLong ' Shuffle mwcRandom a bit more and shuffle mwcCarry
                 GOSUB gsStoreSeq
    
              CASE 0            ' Repeat the last number generated
                FUNCTION = rndE ' will, of course, be zero if no rndE calculated yet
                EXIT FUNCTION
    
              CASE 2           'make it 50/50 + and -
                TogScope = NOT TogScope
    
              CASE <= -1       ' Guarrantees a non-duplicate sequence for each integer -1 thru -2147483648
                               ' so you can select your own repeatable sequences from the 2Gig available. This gives a
                               ' similar functionality to the PB statement "RANDOMIZE number" but without dupe sequences.
                mwcSoph = PEEK(DWORD, CODEPTR(multiplier) - (one MOD 384) * 4)
                mwcRandom = &h55b218da - one 'assures maximum possible 2147483648 unique sequences
                mwcCarry  = &h3fe8700c
                GOSUB gsStoreSeq
                oneTime = 1
                GOTO noParams
    
    
              CASE 3          ' DefaultSequence
                 GOSUB gsDefaultSeq
    
              CASE 4          ' RepeatLastSequence/gotoBookmark
                IF mwcSoph = 0 THEN ' there wasn't a last sequence so use default
                  GOSUB gsDefaultSeq
                ELSE                ' read saved values from storeState string.
                  mwcSoph    = PEEK(DWORD, VARPTR(storeState    ))
                  mwcRandom  = PEEK( LONG, VARPTR(storeState) + 4)
                  mwcCarry   = PEEK( LONG, VARPTR(storeState) + 8)
                END IF
    
              CASE 5          ' Bookmark
                GOSUB gsStoreSeq
    
              CASE ELSE
                GOTO noParams  ' + number > 5, so just generate another EXT rnd
    
            END SELECT
    
          FUNCTION = 0 ' OK
          EXIT FUNCTION
    
          gsDefaultSeq:                'gs prefix means this is a GOSUB sub
            oneTime = 1
            mwcSoph = 4221732234
            mwcRandom = &ha5b218da     ' can be any LONG except &hffffffff and 0
            mwcCarry  = &h3fe8700c     ' can be any number except (mwcSoph-1) and 0
            GOSUB gsStoreSeq
          RETURN
    
          gsStoreSeq:                  'save original starting point of sequence in 12-byte storeState string. This is more
                                       'efficient than creating three separate variables with higher function-call overhead.
            !lea eax, storeState       ;str address
            !mov ecx, mwcSoph
            !mov edx, mwcRandom
            !mov [eax+0], ecx          ;save mwcSoph in storeState str.
            !mov ecx, mwcCarry
            !mov [eax+4], edx          ;save mwcRandom
            !mov [eax+8], ecx          ;save mwcCarry
          RETURN
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      twoParams:   ' both optional parameters passed so it's an integer range which can be quickly calculated...
          IF oneTime = 0 THEN GOSUB gsDefaultSeq
          !push ebx
          !mov eax, one
          !mov ebx, two
          !mov eax, [eax]      ;dereference one
          !mov ebx, [ebx]      ;   "        two
          !cmp eax, ebx        ;is one > two?
          !jg short oneGtTwo   ;jump if one > two
          !sub ebx, eax        ;now ebx is range
          !cmp ebx, &hffffffff ;is it max?
          !jne short rangeNotMax
          !jmp short doTheRnd
         oneGtTwo:             'swap and do like above
          !mov ecx, one        ;replace one with two because two is < one and we need the small bound as "one" below
          !mov[ecx],ebx        ;    "
          !sub eax, ebx        ;now eax holds range
          !cmp eax, &hffffffff ;max?
          !mov ebx, eax        ;save eax because sRandomLong overwrites it. Now ebx holds range
          !jne short rangeNotMax
          'above asm does this:
    '     IF one > two THEN SWAP one, two
    '     range = two - one
    '     IF range <> &hffffffff GOTO rangeNotMax
         doTheRnd:
          !pop ebx
          GOSUB sRandomLong    'get a rndL
          !mov rndL, eax       ;range is max, ie. any LONG integer is wanted, so since that is just what sRandomLong does...
          !fild rndL           ;give the function the direct feed. This is now by far the fastest return from Rnd2.
          !fld st(0)
          !fstp rndE           ;save for repeat last random--Rnd2(0)
          !fstp FUNCTION       ;save to FUNCTION
          EXIT FUNCTION
    
         rangeNotMax:
          !add ebx, 1          ;we want range to be inclusive, eg. Rnd2(1,6) gives 1,2,3,4,5,6 evenly randomized
          GOSUB sRandomLong    'get a random into eax
          !mov edx, ebx        ;a bit of a brainwave: creates perfect random dividend for any range divisor in 3 ticks!
          !sub edx, 1          ;-1 from hi dividend DWORD
          !sub eax, edx        ;adjust lo dividend DWORD and EAX:EDX dividend is now perfect. Hey, I said brainwave :)
          !div ebx             ;ebx is range. remainder goes to edx--same as MOD. Produces random integer within range.
                               'rnd of range size in edx now.
          !mov ecx, one        ;get low range bound
          !mov ecx, [ecx]      ;dereference one
          !add ecx, edx        ;add random value to it within range specified. This is: rndL = one + range
          !mov rndL,ecx        ;finish rndL = one + range
          !pop ebx
          !fild rndL
          !fld st(0)
          !fstp rndE           ;save for repeat last random--Rnd2(0)
          !fstp FUNCTION       ;save to FUNCTION
          EXIT FUNCTION
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     noParams:     ' no optional parameters passed so calculated EXT rnd...
      IF OneTime = 0 THEN GOSUB gsDefaultSeq ' otherwise start crunching
      GOSUB sRandomLong 'sub to generate LONG rnd value
      !mov ecx, eax
      !lea eax, eq              ;eq means 'extended quad', that is, a quad to be converted to an EXT by 'division' later
      !mov [eax], ecx           ; = POKE LONG, eqPtr, rndL << this POKEs a rand to the LO DWORD of eq
    
      reRnd: 'reRnd loop runs avg. of 2.3 loops / Rnd2. It's needed for perfectly linear distribution
        GOSUB sRandomLong
        !and eax, &h0fffffff    ;zero top 4 bits
        !cmp eax, &h0DE0B6B3    ;effectively: LOOP WHILE eq > 999999999999999999. 18 fully random digits
        !jb  short okRnd        ;eq < 999999999999999999 guaranteed so we're ok to go
        !cmp eax, &h0DE0B6B3
        !ja short reRnd         ;eq > 999999999999999999 guaranteed so we need to re-randomize. Can't handle 19 digits.
        !mov ecx, eq            ;eax = &h0DE0B6B3 exactly. 1 in 233 million odds
        !cmp ecx, &hA763FFFF    ;so we need to check LO DWORD of quad
        !ja short reRnd         ;if eq > 999999999999999999 then jmp to re-randomize
      okRnd:
        !lea ecx, eq
        !mov [ecx+4], eax       ; = POKE LONG, eqPtr + 4, rndL
        !fild qword [ecx]       ;float load eq which is now a complete quad random
        '---------------------
        !lea ecx, rndE          ;space to hold the constant 10E-18
        !mov dword ptr[ecx],    &h921d5d07 ;10E-18 save in rndE. This is a binary image of the extended precision 10E-18
        !mov dword ptr[ecx+4],  &h9392ee8e ;             "
        !mov  word ptr[ecx+8],  &h3fc3     ;             "
        !fld tbyte [ecx]        ;float load 10E-18
        !fmulp st(1),st(0)      ;eq * 10E-18 to range rnd to [0,1). This = eq / 10E18 but is much faster
        !cmp togScope, 0        ;do we need to make it 50/50 + and - ?
        !jne short rndNeg
        !fld st(0)              ;copy final answer
        !fstp rndE              ;save copy
        !fstp FUNCTION          ;save FUNCTION
        EXIT FUNCTION
      rndNeg:
        GOSUB sRandomLong       'make a random LONG to determine +/-
        !cmp eax, 0
        !jl short isNeg         ;if -, jump to make it -
        !fld st(0)              ;copy + final answer
        !fstp rndE              ;save copy
        !fstp FUNCTION          ;save FUNCTION
        EXIT FUNCTION
      isNeg:
        !fchs                   ;make neg
        !fld st(0)              ;copy - final answer
        !fstp rndE              ;save copy
        !fstp FUNCTION          ;save FUNCTION
    
    EXIT FUNCTION
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    sRandomLong: 'here we generate a random LONG from 0 to &hffffffff
    !mov eax, mwcSoph
    !mov ecx, mwcRandom
    !mul ecx
    !Add eax, mwcCarry
    !adc edx, 0
    !mov mwcRandom, eax
    !mov mwcCarry,  edx
    RETURN 'done generating, mwcRandom holds final value
    
    multiplier: 'a bunch of Sophie Germain primes. Each makes its own unique sequence of ~2^63 LONG random values
    !DD 4055108289, 4183291290, 4066422669, 4010830218, 4144557798, 4047225099, 4169878863, 4156378278
    !DD 4068734223, 4013003148, 4128794349, 4044603045, 4147482834, 4050081738, 4169007204, 4084483623
    !DD 4182936234, 4061167764, 4116557445, 4184835774, 4098609075, 4000058700, 4005596580, 4131991143
    !DD 4026365904, 4082490609, 4170263943, 4064971044, 4192040679, 4069686423, 4112450355, 4116008373
    !DD 4051352658, 4131639393, 4026209880, 4143019908, 4057560153, 4153038378, 4178347353, 4101943515
    !DD 4163817693, 4126770675, 4122227184, 4150506573, 4124871525, 4097114355, 4171215009, 4094254353
    !DD 4185190458, 4184112513, 4187782989, 4037092584, 4114448259, 4096721880, 4003880118, 4035500259
    !DD 4080989598, 4090215738, 4104202098, 4144153608, 4027213065, 4112123319, 4029634383, 4188620745
    !DD 4003957254, 4158202674, 4165028370, 4101889029, 4064867064, 4056294705, 4117302630, 4094813610
    !DD 4089078504, 4072584339, 4075250574, 4144182519, 4020827805, 4077052605, 4012941570, 4114015830
    !DD 4015303260, 4012049835, 4031934513, 4123667379, 4025171265, 4149021864, 4020494469, 4152989853
    !DD 4141465314, 4050172164, 4130534940, 4124347128, 4155032220, 4123523313, 4038610005, 4066391700
    !DD 4052359893, 4138494750, 4046848368, 4015233183, 4065337650, 4181156010, 4149686553, 4115669703
    !DD 4080411408, 4029985884, 4072279314, 4136476293, 4102312674, 4148638644, 4020161274, 4056852945
    !DD 4084467288, 4090139205, 4152479904, 4129623354, 4189154793, 4042650633, 4113056934, 4070634510
    !DD 4172190345, 4012616748, 4092782529, 4042027470, 4034320863, 4017110193, 4128178095, 4005317820
    !DD 4121565819, 4160465475, 4093432608, 4094047308, 4092039654, 4132108680, 4160799915, 4109110719
    !DD 4190254803, 4063105479, 4123739478, 4086096945, 4113466908, 4169157873, 4036670034, 4035486873
    !DD 4154194098, 4074334704, 4006945965, 4119880785, 4050935955, 4131729105, 4170646809, 4191996963
    !DD 4055775498, 4029162399, 4118132214, 4116397584, 4121266560, 4102454433, 4146555864, 4103353149
    !DD 4119974010, 4080379233, 4192378968, 4061071950, 4104928533, 4042978743, 4188739878, 4066717740
    !DD 4017709695, 4027617453, 4110604308, 4107339654, 4076278878, 4077074274, 4097495403, 4179562659
    !DD 4187765853, 4187454249, 4015793904, 4083863454, 4078492929, 4166495943, 4101303048, 4149525330
    !DD 4095286830, 4078227909, 4189944624, 4010811645, 4032304584, 4151394078, 4044317298, 4136517915
    !DD 4198354635, 4192501860, 4073134869, 4060180830, 4076815050, 4190613315, 4142749785, 4122567564
    !DD 4071542523, 4024430004, 4122798648, 4041267495, 4006243575, 4092566124, 4141397349, 4175565558
    !DD 4159829190, 4173505479, 4084339563, 4085131608, 4081507743, 4069428324, 4011038568, 4092438129
    !DD 4005482298, 4020895359, 4127615184, 4162803795, 4038272028, 4123171464, 4199942199, 4067713245
    !DD 4129181838, 4021766328, 4141102845, 4002607668, 4051580310, 4082443044, 4078962945, 4072199883
    !DD 4180693749, 4040763375, 4025696004, 4066226853, 4013137770, 4084688994, 4081465923, 4185884010
    !DD 4184193840, 4095653625, 4071642489, 4003011123, 4021708860, 4038391383, 4003548888, 4016275635
    !DD 4051483344, 4052001093, 4131504594, 4129105653, 4187278653, 4058921709, 4167113355, 4106971188
    !DD 4074045393, 4069825200, 4009724565, 4120937589, 4119577560, 4151390115, 4000637598, 4088788530
    !DD 4014859458, 4003633353, 4192075623, 4009856424, 4048255155, 4100175633, 4129717695, 4012882215
    !DD 4119226824, 4122492603, 4074693864, 4062187338, 4022104890, 4186039455, 4191285474, 4165800789
    !DD 4047934929, 4045886208, 4028478450, 4098395724, 4095869853, 4004229753, 4110500373, 4188458055
    !DD 4093944063, 4122368673, 4136075109, 4024434645, 4145270010, 4121262090, 4051650480, 4076720613
    !DD 4057135713, 4053301650, 4074379569, 4103950185, 4146078999, 4029125490, 4036104003, 4122595203
    !DD 4173008610, 4155931704, 4048316175, 4178853645, 4049069715, 4187855514, 4193714559, 4132340133
    !DD 4001184978, 4087342068, 4038996009, 4032782589, 4103313705, 4057212699, 4094324010, 4117022988
    !DD 4016133978, 4057176333, 4081210119, 4183410330, 4054406019, 4008415374, 4131217578, 4049176725
    !DD 4033804230, 4154677353, 4194818769, 4057689999, 4065887250, 4083913149, 4160269749, 4148719650
    !DD 4086572148, 4079152770, 4198797849, 4025836533, 4121774838, 4114818903, 4193265369, 4005720123
    !DD 4172736744, 4113446385, 4153872675, 4022863908, 4169665353, 4080875223, 4148976378, 4158173325
    !DD 4012107315, 4146530883, 4042645638, 4189878099, 4075365840, 4053276279, 4112504730, 4144260888
    !DD 4102144035, 4181673825, 4171915968, 4123257354, 4032551355, 4054454535, 4132616253, 4057321905
    !DD 4174490559, 4165419468, 4169862234, 4116771594, 4009920498, 4164231630, 4163597154, 4181713095
    !DD 4000268439, 4077171264, 4045424718, 4116626304, 4052701140, 4140380880, 4027965249, 4102323183
    
    END FUNCTION
    '

  • #2
    Rnd2 discussion

    Discussion here

    Comment


    • #3
      CryptoRandom: This additional Case for trueRandom.inc requires XP and/or Vista and CC5 and/or PB9.

      For comments go to post #32 here.

      In the example code above add:

      #Include "WIN32API.INC"

      In PBMain add:

      Let GetCrypto = Class "CCryptoRand"

      at the top, and add

      GetCrypto = Nothing

      at the bottom.

      In trueRandom.inc add:

      NB: I had (-1), now (6)

      Macro CryptoRandom = Rnd2(6)

      and then before Function Rnd2 add:

      Code:
      Global GetCrypto As ICryptoRand
       
      Declare Function RtlGenRandom( RandomBuffer As Byte, ByVal RandomBufferLength As Dword ) As Long
       
      Type mwcParams
        Mult As Word
        Random As Long
        Carry As Long
      End Type
       
      Union CryptoBuffer
       sDummy As String * 10
       mwc As mwcParams
      End Union
       
      Class CCryptoRand
       
        Instance hLib, hProc As Dword
       
        Class Method Create
          hLib = LoadLibrary( "advapi32.dll")
          hProc = GetProcAddress(hLib, "SystemFunction036")
        End Method
       
        Class Method Destroy
          FreeLibrary hLib
        End Method
       
        Interface ICryptoRand: Inherit IUnknown
       
          Method Bytes( x As CryptoBuffer) As Long
            Dim BinaryByte(10) As Byte
            Local BinarySize As Dword
       
            BinarySize = 10
       
            Call Dword hProc Using RtlGenRandom( BinaryByte(0), ByVal BinarySize )
       
            x.sDummy = Peek$( VarPtr( BinaryByte(0) ), BinarySize )
       
          End Method
       
        End Interface
       
      End Class
      In Function Rnd2 add:

      Local Buffer As CryptoBuffer

      NB: I had -1, now 6

      and add Case 6

      Code:
      Case 6 ' Was -1
        oneTime = 1
        GetCrypto.Bytes(Buffer) ' Get 10 cryptographic bytes
        mwcSoph = Peek(Dword, CodePtr(multiplier) + (Buffer.mwc.Mult Mod 384) * 4)
        mwcRandom = Buffer.mwc.Random
        If Abs(mwcRandom) <= 1 Then ' A very rare event
          mwcRandom = Buffer.mwc.Carry ' Try the Carry entry
          If Abs(mwcRandom) <= 1 Then ' Playing hard to get, eh?
            Do
              GetCrypto.Bytes(Buffer) ' Get another set
              mwcRandom = Buffer.mwc.Random
              If Abs(mwcRandom) > 1 Then Exit Loop ' Should be on a winner here
              mwcRandom = Buffer.mwc.Carry ' The odds are getting astronomical now.
            Loop Until Abs(mwcRandom) > 1
          End If
        End If
        mwcCarry = Buffer.mwc.Carry ' May have been ued by mwcRandom, but not a problem
        If (mwcCarry = mwcSoph - 1) Or (mwcCarry = 0) Then ' Less chance than mwcRandom failing
          Do
            GetCrypto.Bytes(Buffer) ' Get another set
            mwcCarry = Buffer.mwc.Random
            If (mwcCarry <> mwcSoph - 1) And (mwcCarry <> 0) Then Exit Loop ' > changed to <>
            mwcCarry = Buffer.mwc.Carry
          Loop Until (mwcCarry <> mwcSoph - 1) And (mwcCarry <> 0) ' > changed to <>
        End If
        GoSub gsStoreSeq
      Last edited by David Roberts; 6 Oct 2008, 03:36 PM. Reason: Changed Case -1 to Case 6

      Comment


      • #4
        OOPS

        CASE -1 changed to CASE 6, there is a CASE <= -1

        Thanks to John Gleason for pointed that out to me.

        Comment


        • #5
          CryptoRandom revisited : This additional Case for trueRandom.inc requires CC5 and/or PB9.

          SDK
          Client: Included in Windows XP, Windows 2000 Professional, Windows NT Workstation 4.0, Windows Me, Windows 98, Windows 95 OSR2 and later.

          In post #3 above replace the Code section headed 'Global GetCrypto As ICryptoRand' with the following - everthing else holds.

          Code:
          Global GetCrypto As ICryptoRand
          
          Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
                ( hProv As Long, zContainer As Asciiz, zProvider As Asciiz, _
                   ByVal dwProvType As Dword, ByVal dwFlags As Dword ) As Long
          Declare Function CryptReleaseContext Lib "advapi32.dll" Alias "CryptReleaseContext" _
                ( ByVal hProv As Long, ByVal dwFlags As Dword ) As Long
          Declare Function CryptGenRandom Lib "advapi32.dll" Alias "CryptGenRandom" _
                ( ByVal hProv As Long, ByVal dwLen As Dword, pbBuffer As Byte) As Long
          
          Type mwcParams
            Mult As Word
            Random As Long
            Carry As Long
          End Type
          
          Union CryptoBuffer
           sDummy As String * 10
           mwc As mwcParams
          End Union
          
          Class CCryptoRand
          
            Instance hProv As Dword
            
            Class Method Create
              Local Prov_Rsa_Full, Flags As Dword
              Dim MS_Def_Prov As Asciiz * 50
              
              Prov_Rsa_Full = 1
              Flags = &hF0000000
              MS_Def_Prov = "Microsoft Base Cryptographic Provider v1.0"
              
              CryptAcquireContext( hProv, ByVal %Null, ByVal %Null, Prov_Rsa_Full, Flags )
              CryptAcquireContext( hProv, ByVal %Null, MS_Def_Prov, Prov_Rsa_Full, Flags )
            End Method
            
            Class Method Destroy
              CryptReleaseContext hProv, 0
            End Method
            
            Interface ICryptoRand: Inherit IUnknown
              
              Method Bytes( x As CryptoBuffer) As Long
                Dim BinaryByte(10) As Byte
                Local BinarySize As Dword
                
                BinarySize = 10
                
                CryptGenRandom( ByVal hProv, ByVal BinarySize,  BinaryByte(0))
                      
                x.sDummy = Peek$( VarPtr( BinaryByte(0) ), BinarySize )
                
              End Method
              
            End Interface
          
          End Class

          Comment

          Working...
          X