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

correct the output of random.sfmt

db4
Doug Coleman 2009-10-07 13:42:37 -05:00
parent 901f87e752
commit 211eff745a
2 changed files with 24 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,13 +4,13 @@ USING: accessors kernel random random.sfmt random.sfmt.private
sequences tools.test ; sequences tools.test ;
IN: random.sfmt.tests IN: random.sfmt.tests
[ ] [ 100 <sfmt-19937> drop ] unit-test [ ] [ 5 <sfmt-19937> drop ] unit-test
[ 1096298955 ] [ 1331696015 ]
[ 100 <sfmt-19937> dup generate dup generate uint-array>> first ] unit-test [ 5 <sfmt-19937> dup generate dup generate uint-array>> first ] unit-test
[ 2556114782 ] [ 1432875926 ]
[ 100 <sfmt-19937> random-32* ] unit-test [ 5 <sfmt-19937> random-32* ] unit-test
[ t ] [ t ]
[ [

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

@ -16,7 +16,7 @@ STRUCT: sfmt-state
{ seed uint } { seed uint }
{ n uint } { n uint }
{ m uint } { m uint }
{ ix uint } { index uint }
{ mask uint-4 } { mask uint-4 }
{ r1 uint-4 } { r1 uint-4 }
{ r2 uint-4 } ; { r2 uint-4 } ;
@ -50,14 +50,15 @@ M:: sfmt generate ( sfmt -- )
sfmt uint-4-array>> :> array sfmt uint-4-array>> :> array
state n>> 2 - array nth state (>>r1) state n>> 2 - array nth state (>>r1)
state n>> 1 - array nth state (>>r2) state n>> 1 - array nth state (>>r2)
state m>> :> m state m>> :> m
state n>> :> n state n>> :> n
state mask>> :> mask state mask>> :> mask
n m - >fixnum iota [| i | n m - >fixnum iota [| i |
i array nth-unsafe i array nth-unsafe
i m + array nth-unsafe i m + array nth-unsafe
mask state r1>> state r2>> formula :> r mask state r1>> state r2>> formula :> r
! USE: io "r = " write r .
r i array set-nth-unsafe r i array set-nth-unsafe
state r2>> state (>>r1) state r2>> state (>>r1)
@ -75,19 +76,17 @@ M:: sfmt generate ( sfmt -- )
state r2>> state (>>r1) state r2>> state (>>r1)
r state (>>r2) r state (>>r2)
] each ] each
0 state (>>ix) ; 0 state (>>index) ;
: <sfmt-array> ( sfmt -- uint-array uint-4-array ) : <sfmt-array> ( sfmt -- uint-array uint-4-array )
state>> state>>
[ n>> 4 * iota >uint-array ] [ seed>> ] bi [ n>> 4 * 1 swap [a,b] >uint-array ] [ seed>> ] bi
[ [
[ [
[ [ -30 shift ] [ ] bi bitxor
[ -30 shift ] [ ] bi bitxor state-multiplier * 32 bits
state-multiplier * 32 bits ] dip + 32 bits
] dip +
] unless-zero 32 bits
] uint-array{ } accumulate-as nip ] uint-array{ } accumulate-as nip
dup underlying>> byte-array>uint-4-array ; dup underlying>> byte-array>uint-4-array ;
@ -97,7 +96,7 @@ M:: sfmt generate ( sfmt -- )
swap >>m swap >>m
swap >>n swap >>n
swap >>seed swap >>seed
0 >>ix ; 0 >>index ;
: init-sfmt ( sfmt -- sfmt' ) : init-sfmt ( sfmt -- sfmt' )
dup <sfmt-array> [ >>uint-array ] [ >>uint-4-array ] bi* dup <sfmt-array> [ >>uint-array ] [ >>uint-4-array ] bi*
@ -110,13 +109,13 @@ M:: sfmt generate ( sfmt -- )
init-sfmt ; inline init-sfmt ; inline
: refill-sfmt? ( sfmt -- ? ) : refill-sfmt? ( sfmt -- ? )
state>> [ ix>> ] [ n>> 4 * ] bi >= ; state>> [ index>> ] [ n>> 4 * ] bi >= ;
: next-ix ( sfmt -- ix ) : next-index ( sfmt -- index )
state>> [ dup 1 + ] change-ix drop ; inline state>> [ dup 1 + ] change-index drop ; inline
: next ( sfmt -- n ) : next ( sfmt -- n )
[ next-ix ] [ uint-array>> ] bi nth-unsafe ; inline [ next-index ] [ uint-array>> ] bi nth-unsafe ; inline
PRIVATE> PRIVATE>
@ -128,5 +127,6 @@ M: sfmt seed-random ( sfmt seed -- sfmt )
[ drop init-sfmt ] 2bi ; [ drop init-sfmt ] 2bi ;
: <sfmt-19937> ( seed -- sfmt ) : <sfmt-19937> ( seed -- sfmt )
348 330 uint-4{ HEX: BFFFFFF6 HEX: BFFAFFFF HEX: DDFECB7F HEX: DFFFFFEF } 156 122
uint-4{ HEX: DFFFFFEF HEX: DDFECB7F HEX: BFFAFFFF HEX: BFFFFFF6 }
<sfmt> ; inline <sfmt> ; inline