steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

rice mersenne-twister - replace mod with a subtraction

db4
Doug Coleman 2008-12-03 18:15:14 -06:00
parent f75fdc5744
commit 3a2b0cc1fb
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/random/mersenne-twister/mersenne-twister.factor
View File

@ -15,11 +15,14 @@ TUPLE: mersenne-twister { seq uint-array } { i fixnum } ;
: mt-m 397 ; inline : mt-m 397 ; inline
: mt-a HEX: 9908b0df ; inline : mt-a HEX: 9908b0df ; inline
: mersenne-wrap ( n -- n' )
dup mt-n > [ mt-n - ] when ; inline
: wrap-nth ( n seq -- obj ) : wrap-nth ( n seq -- obj )
[ length mod ] keep nth-unsafe ; inline [ mersenne-wrap ] dip nth-unsafe ; inline
: set-wrap-nth ( obj n seq -- ) : set-wrap-nth ( obj n seq -- )
[ length mod ] keep set-nth-unsafe ; inline [ mersenne-wrap ] dip set-nth-unsafe ; inline
: calculate-y ( n seq -- y ) : calculate-y ( n seq -- y )
[ wrap-nth 31 mask-bit ] [ wrap-nth 31 mask-bit ]
@ -50,7 +53,7 @@ TUPLE: mersenne-twister { seq uint-array } { i fixnum } ;
: init-mt-seq ( seed -- seq ) : init-mt-seq ( seed -- seq )
32 bits mt-n <uint-array> 32 bits mt-n <uint-array>
[ set-first ] [ init-mt-rest ] [ ] tri ; [ set-first ] [ init-mt-rest ] [ ] tri ; inline
: mt-temper ( y -- yt ) : mt-temper ( y -- yt )
dup -11 shift bitxor dup -11 shift bitxor