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

cleaning up sfmt

db4
Doug Coleman 2009-10-02 00:21:48 -05:00
parent f3ef312e83
commit 926ed2d5e1
2 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/random/sfmt/sfmt-tests.factor
View File

@ -1,6 +1,8 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: tools.test random.sfmt ; USING: accessors kernel random.sfmt sequences tools.test ;
IN: random.sfmt.tests IN: random.sfmt.tests
[ ] [ 100 <sfmt-19937> drop ] unit-test [ ] [ 100 <sfmt-19937> drop ] unit-test
[ 1096298955 ]
[ 100 <sfmt-19937> generate generate state>> first first ] unit-test

10
basis/random/sfmt/sfmt.factor
View File

@ -17,7 +17,7 @@ CONSTANT: state-multiplier 1812433253
TUPLE: sfmt TUPLE: sfmt
sl1 sl2 sr1 sr2 mask parity sl1 sl2 sr1 sr2 mask parity
{ seed integer } { n fixnum } { m fixnum } { seed integer } { n fixnum } { m fixnum }
{ ix fixnum } { state uint-4-array } ; { m-n fixnum } { ix fixnum } { state uint-4-array } ;
: init-state ( sfmt -- sfmt' ) : init-state ( sfmt -- sfmt' )
dup [ n>> 4 * iota >uint-array ] [ seed>> ] bi dup [ n>> 4 * iota >uint-array ] [ seed>> ] bi
@ -55,8 +55,9 @@ M:: sfmt generate ( sfmt -- sfmt' )
sfmt n>> 1 - sfmt state>> nth :> r2! sfmt n>> 1 - sfmt state>> nth :> r2!
0 :> r! 0 :> r!
0 :> i! 0 :> i!
sfmt n>> :> n
sfmt m>> :> m sfmt m>> :> m
sfmt n>> :> n
sfmt m-n>> :> m-n
sfmt mask>> :> mask sfmt mask>> :> mask
sfmt state>> :> state sfmt state>> :> state
@ -71,10 +72,10 @@ M:: sfmt generate ( sfmt -- sfmt' )
r r2! r r2!
] each ] each
i 1 + n [a,b) [ n m - 1 + n [a,b) [
i! i!
i state nth i state nth
m n - i + state nth m-n i + state nth
mask r1 r2 formula r! mask r1 r2 formula r!
r i state set-nth r i state set-nth
@ -95,6 +96,7 @@ M:: sfmt generate ( sfmt -- sfmt' )
swap >>m swap >>m
swap >>n swap >>n
swap 32 bits >>seed swap 32 bits >>seed
dup [ m>> ] [ n>> ] bi - >>m-n
0 >>ix 0 >>ix
init-state init-state
generate ; generate ;