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

add seed-random method to random.sfmt, fix formatting

db4
Doug Coleman 2009-10-02 01:54:17 -05:00
parent 907e401542
commit 4cb927722d
1 changed files with 12 additions and 5 deletions
basis/random/sfmt

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

@ -22,9 +22,9 @@ STRUCT: sfmt-state
{ r2 uint-4 } ; { r2 uint-4 } ;
TUPLE: sfmt TUPLE: sfmt
{ state sfmt-state } { state sfmt-state }
{ uint-array uint-array } { uint-array uint-array }
{ uint-4-array uint-4-array } ; { uint-4-array uint-4-array } ;
: wA ( w -- wA ) : wA ( w -- wA )
dup 1 hlshift vbitxor ; inline dup 1 hlshift vbitxor ; inline
@ -99,12 +99,15 @@ M:: sfmt generate ( sfmt -- )
swap >>seed swap >>seed
0 >>ix ; 0 >>ix ;
: init-sfmt ( sfmt -- sfmt' )
dup <sfmt-array> [ >>uint-array ] [ >>uint-4-array ] bi*
[ generate ] keep ; inline
: <sfmt> ( seed n m mask -- sfmt ) : <sfmt> ( seed n m mask -- sfmt )
<sfmt-state> <sfmt-state>
sfmt new sfmt new
swap >>state swap >>state
dup <sfmt-array> [ >>uint-array ] [ >>uint-4-array ] bi* init-sfmt ; inline
[ generate ] keep ; inline
: refill-sfmt? ( sfmt -- ? ) : refill-sfmt? ( sfmt -- ? )
state>> [ ix>> ] [ n>> 4 * ] bi >= ; state>> [ ix>> ] [ n>> 4 * ] bi >= ;
@ -120,6 +123,10 @@ PRIVATE>
M: sfmt random-32* ( sfmt -- n ) M: sfmt random-32* ( sfmt -- n )
dup refill-sfmt? [ dup generate ] when next ; inline dup refill-sfmt? [ dup generate ] when next ; inline
M: sfmt seed-random ( sfmt seed -- sfmt )
[ [ state>> ] dip >>seed drop ]
[ drop init-sfmt ] 2bi ;
: <sfmt-19937> ( seed -- sfmt ) : <sfmt-19937> ( seed -- sfmt )
348 330 uint-4{ HEX: BFFFFFF6 HEX: BFFAFFFF HEX: DDFECB7F HEX: DFFFFFEF } 348 330 uint-4{ HEX: BFFFFFF6 HEX: BFFAFFFF HEX: DDFECB7F HEX: DFFFFFEF }
<sfmt> ; inline <sfmt> ; inline