mirror of
https://git.sr.ht/~crc_/retroforth
synced 2024-11-16 19:48:56 +01:00
154 lines
4.7 KiB
Text
154 lines
4.7 KiB
Text
## xoroshiro128**
|
|
|
|
XOR/rotate/shift/rotate PNRG (See http://xoshiro.di.unimi.it/)
|
|
|
|
|
|
~~~
|
|
{{
|
|
'JUMP d:create #2271477771 , #4114797267 , #1872770499 , #2012404571 ,
|
|
'k var 't var 's0 var 's1 var 's2 var 's3 var
|
|
:reseed (n-) dup !s1 dup !s2 dup !s3 dup !k !t ;
|
|
:rotl (x-) !k [ @k n:negate shift ] [ #32 @k - shift ] bi or ;
|
|
:res** (-n) @s0 #5 * #7 rotl #9 * ;
|
|
:next (-)
|
|
@s1 dup #-9 shift push @s3 @s0 @s2
|
|
as{
|
|
'pudupoxo i
|
|
'pupu.... i
|
|
'pudupoxo i
|
|
'swposwpo i
|
|
'dupuxopu i
|
|
'pudupoxo i
|
|
'popopoxo i
|
|
}as
|
|
!s2 !s1 !s0 #11 rotl !s3 ;
|
|
|
|
:xor-er (nananana-nananana)
|
|
as{
|
|
'dupufexo i 'pu...... i
|
|
'dupufexo i 'pu...... i
|
|
'dupufexo i 'pu...... i
|
|
'dupufexo i 'pu...... i
|
|
'popopopo i 'popopopo i
|
|
}as ;
|
|
:jump? (nm-) [ JUMP + fetch ] dip #1 swap n:negate shift and ;
|
|
:inner (n-n)
|
|
#32 [ dup I jump? [ [ xor-er ] dip ] if next ] times<with-index> ;
|
|
|
|
---reveal---
|
|
:random:xoroshiro128** (-n)
|
|
next res** ;
|
|
|
|
:random:xoroshiro128**:jump (-)
|
|
#0 &s3 #0 &s2 #0 &s1 #0 &s0
|
|
#4 [ I inner drop ] times<with-index>
|
|
as{ 'stststst i }as ;
|
|
|
|
:random:xoroshiro128**:set-seed (n-)
|
|
reseed #100 [ next ] times ;
|
|
|
|
:random:xoroshiro128**:test-seed (nnnn-)
|
|
!s0 !s1 !s2 !s3 ;
|
|
}}
|
|
~~~
|
|
|
|
## Mersenne Twister
|
|
|
|
This is adapted from Samuel A. Falvo II's implementation. The
|
|
original commentary follows:
|
|
|
|
As taken from ttp://en.wikipedia.org/wiki/Mersenne_twister
|
|
|
|
I am aware of Wil Baden's sources, but I had difficulty
|
|
getting it to compile under SwiftForth out of the box.
|
|
|
|
This module exposes the following API:
|
|
|
|
seeded ( uSeed -- )
|
|
Seeds the random number generator with the provided 32-bit,
|
|
unsigned value.
|
|
|
|
probability ( -- u )
|
|
Returns a random value that falls in the range [0,
|
|
$FFFFFFFF].
|
|
|
|
All other definitions are safe to shadow/redefine elsewhere.
|
|
|
|
Copyright (c) 2010, Samuel A. Falvo II
|
|
All rights reserved.
|
|
|
|
Redistribution and use in source and binary forms, with or
|
|
without modification, are permitted provided that the following
|
|
conditions are met:
|
|
|
|
* Redistributions of source code must retain the above copyright
|
|
notice, this list of conditions and the following disclaimer.
|
|
|
|
* Redistributions in binary form must reproduce the above
|
|
copyright notice, this list of conditions and the following
|
|
disclaimer in the documentation and/or other materials
|
|
provided with the distribution.
|
|
|
|
* Neither the name of Samuel A. Falvo II, Falvo Technical
|
|
Solutions, nor the names of its contributors may be used to
|
|
endorse or promote products derived from this software
|
|
without specific prior written permission.
|
|
|
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
|
|
CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
|
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
|
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
|
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
|
|
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
|
|
USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
|
|
AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
|
|
IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
|
|
THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
In adapting this, some concessions were made since RETRO only
|
|
has signed 32-bit values.
|
|
|
|
random:mersenne:set-seed (n-)
|
|
Seeds the random number generator with the provided 32-bit,
|
|
unsigned value.
|
|
|
|
random:mersenne (-n)
|
|
Returns a random value that falls in the range [0,
|
|
n:MAX].
|
|
|
|
~~~
|
|
{{
|
|
'States d:create #625 allot
|
|
'Index var
|
|
|
|
:reset (n-)
|
|
&States over n:dec + dup fetch #30 shift swap fetch
|
|
xor #1812433253 * over + n:MAX and swap &States + store ;
|
|
|
|
:randomized (-)
|
|
#1 [ dup reset n:inc dup #624 gt? ] until drop ;
|
|
|
|
:y (n-y)
|
|
dup n:inc #624 mod &States + fetch n:MAX and
|
|
swap &States + fetch #-31 shift + ;
|
|
|
|
:altered (n-)
|
|
dup y dup #1 and #1073741823 *
|
|
[ #2 / over #397 + #624 mod &States + fetch xor ] dip
|
|
xor swap &States + store ;
|
|
|
|
:scrambled (-)
|
|
#0 [ dup altered n:inc dup #624 gt? ] until drop ;
|
|
---reveal---
|
|
:random:mersenne:set-seed (n-)
|
|
!States #0 !Index randomized ;
|
|
|
|
:random:mersenne (-n)
|
|
@Index n:zero? &scrambled if @Index &States + fetch
|
|
dup #11 shift xor dup #-7 shift #1073741823 and xor dup #-15 shift
|
|
#2011365376 and xor dup #18 shift xor @Index n:inc #624 mod !Index ;
|
|
}}
|
|
~~~
|