diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index 2aa6f45897..d3a5fad4ca 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. ! mersenne twister based on ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c - USING: arrays kernel math namespaces sequences system init -accessors math.ranges random circular math.bitfields.lib ; +accessors math.ranges random circular math.bitfields.lib +combinators ; IN: random.mersenne-twister r >r >r [ 2/ ] [ odd? mt-a 0 ? ] bi - r> bitxor bitxor r> r> set-nth ; inline : calculate-y ( y1 y2 mt -- y ) - tuck [ nth mt-hi ] [ nth mt-lo ] 2bi* bitor ; inline + tuck + [ nth 32 mask-bit ] + [ nth 31 bits ] 2bi* bitor ; inline -: (mt-generate) ( n mt-seq -- y to from-elt ) - [ >r dup 1+ r> calculate-y ] - [ >r mt-m + r> nth ] - [ drop ] 2tri ; +: (mt-generate) ( n mt-seq -- next-mt ) + [ + [ dup 1+ ] [ calculate-y ] bi* + [ 2/ ] [ odd? mt-a 0 ? ] bi bitxor + ] [ + [ mt-m + ] [ nth ] bi* + ] 2bi bitxor ; : mt-generate ( mt -- ) - [ >r mt-n r> seq>> [ [ (mt-generate) ] keep set-generated ] curry each ] - [ 0 >>i drop ] bi ; + [ + mt-n swap seq>> [ + [ (mt-generate) ] [ set-nth ] 2bi + ] curry each + ] [ 0 >>i drop ] bi ; -: init-mt-formula ( seq i -- f(seq[i]) ) - tuck swap nth dup -30 shift bitxor 1812433253 * + - 1+ 32-bit ; +: init-mt-formula ( i seq -- f(seq[i]) ) + dupd nth dup -30 shift bitxor 1812433253 * + 1+ 32 bits ; : init-mt-rest ( seq -- ) - mt-n 1- [ - dupd [ init-mt-formula ] keep 1+ rot set-nth - ] with each ; + mt-n 1- swap [ + [ init-mt-formula ] [ >r 1+ r> set-nth ] 2bi + ] curry each ; : init-mt-seq ( seed -- seq ) - 32-bit mt-n 0 + 32 bits mt-n 0 [ set-first ] [ init-mt-rest ] [ ] tri ; : mt-temper ( y -- yt ) @@ -52,6 +53,9 @@ TUPLE: mersenne-twister seq i ; dup 15 shift HEX: efc60000 bitand bitxor dup -18 shift bitxor ; inline +: next-index ( mt -- i ) + dup i>> dup mt-n < [ nip ] [ drop mt-generate 0 ] if ; + PRIVATE> : ( seed -- obj ) @@ -62,7 +66,6 @@ M: mersenne-twister seed-random ( mt seed -- ) init-mt-seq >>seq drop ; M: mersenne-twister random-32* ( mt -- r ) - dup [ i>> ] [ seq>> ] bi - over mt-n < [ nip >r dup mt-generate 0 r> ] unless - nth mt-temper - swap [ 1+ ] change-i drop ; + [ next-index ] + [ seq>> nth mt-temper ] + [ [ 1+ ] change-i drop ] tri ;