diff --git a/basis/random/sfmt/sfmt-tests.factor b/basis/random/sfmt/sfmt-tests.factor index 7e6a996278..9f3fea0480 100644 --- a/basis/random/sfmt/sfmt-tests.factor +++ b/basis/random/sfmt/sfmt-tests.factor @@ -11,3 +11,10 @@ IN: random.sfmt.tests [ 2556114782 ] [ 100 random-32* ] unit-test + +[ t ] +[ + 100 + [ random-32* ] + [ 100 seed-random random-32* ] bi = +] unit-test diff --git a/basis/random/sfmt/sfmt.factor b/basis/random/sfmt/sfmt.factor index 23f4b8ad33..6b0fc66be2 100644 --- a/basis/random/sfmt/sfmt.factor +++ b/basis/random/sfmt/sfmt.factor @@ -16,16 +16,15 @@ STRUCT: sfmt-state { seed uint } { n uint } { m uint } - { m-n int } { ix uint } { mask uint-4 } { r1 uint-4 } { r2 uint-4 } ; TUPLE: sfmt -{ state sfmt-state } -{ uint-array uint-array } -{ uint-4-array uint-4-array } ; + { state sfmt-state } + { uint-array uint-array } + { uint-4-array uint-4-array } ; : wA ( w -- wA ) dup 1 hlshift vbitxor ; inline @@ -53,7 +52,6 @@ M:: sfmt generate ( sfmt -- ) state n>> 1 - array nth state (>>r2) state m>> :> m state n>> :> n - state m-n>> :> m-n state mask>> :> mask n m - >fixnum iota [| i | @@ -70,7 +68,7 @@ M:: sfmt generate ( sfmt -- ) m 1 - iota [ n m - 1 + + >fixnum :> i i array nth-unsafe - m-n i + array nth-unsafe + m n - i + array nth-unsafe mask state r1>> state r2>> formula :> r r i array set-nth-unsafe @@ -99,15 +97,17 @@ M:: sfmt generate ( sfmt -- ) swap >>m swap >>n swap >>seed - dup [ m>> ] [ n>> ] bi - >>m-n 0 >>ix ; +: init-sfmt ( sfmt -- sfmt' ) + dup [ >>uint-array ] [ >>uint-4-array ] bi* + [ generate ] keep ; inline + : ( seed n m mask -- sfmt ) sfmt new swap >>state - dup [ >>uint-array ] [ >>uint-4-array ] bi* - [ generate ] keep ; + init-sfmt ; inline : refill-sfmt? ( sfmt -- ? ) state>> [ ix>> ] [ n>> 4 * ] bi >= ; @@ -121,8 +121,12 @@ M:: sfmt generate ( sfmt -- ) PRIVATE> M: sfmt random-32* ( sfmt -- n ) - dup refill-sfmt? [ dup generate ] when next ; + dup refill-sfmt? [ dup generate ] when next ; inline + +M: sfmt seed-random ( sfmt seed -- sfmt ) + [ [ state>> ] dip >>seed drop ] + [ drop init-sfmt ] 2bi ; : ( seed -- sfmt ) 348 330 uint-4{ HEX: BFFFFFF6 HEX: BFFAFFFF HEX: DDFECB7F HEX: DFFFFFEF } - ; + ; inline diff --git a/extra/benchmark/sfmt/authors.txt b/extra/benchmark/sfmt/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/benchmark/sfmt/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/benchmark/sfmt/sfmt.factor b/extra/benchmark/sfmt/sfmt.factor new file mode 100644 index 0000000000..9b4c6e43c8 --- /dev/null +++ b/extra/benchmark/sfmt/sfmt.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: fry kernel math random random.sfmt ; +IN: benchmark.sfmt + +: sfmt-benchmark ( n -- ) + >fixnum HEX: 533d '[ _ random-32* drop ] times ; + +: sfmt-main ( -- ) 100000000 sfmt-benchmark ; + +MAIN: sfmt-main