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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-10-02 02:32:50 -05:00
parent cb71fbf4fe deabbb46b5
commit a41b807f83
4 changed files with 34 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -11,3 +11,10 @@ IN: random.sfmt.tests
[ 2556114782 ] [ 2556114782 ]
[ 100 <sfmt-19937> random-32* ] unit-test [ 100 <sfmt-19937> random-32* ] unit-test
[ t ]
[
100 <sfmt-19937>
[ random-32* ]
[ 100 seed-random random-32* ] bi =
] unit-test

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

@ -16,16 +16,15 @@ STRUCT: sfmt-state
{ seed uint } { seed uint }
{ n uint } { n uint }
{ m uint } { m uint }
{ m-n int }
{ ix uint } { ix uint }
{ mask uint-4 } { mask uint-4 }
{ r1 uint-4 } { r1 uint-4 }
{ 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
@ -53,7 +52,6 @@ M:: sfmt generate ( sfmt -- )
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 m-n>> :> m-n
state mask>> :> mask state mask>> :> mask
n m - >fixnum iota [| i | n m - >fixnum iota [| i |
@ -70,7 +68,7 @@ M:: sfmt generate ( sfmt -- )
m 1 - iota [ m 1 - iota [
n m - 1 + + >fixnum :> i n m - 1 + + >fixnum :> i
i array nth-unsafe i array nth-unsafe
m-n i + array nth-unsafe m n - i + array nth-unsafe
mask state r1>> state r2>> formula :> r mask state r1>> state r2>> formula :> r
r i array set-nth-unsafe r i array set-nth-unsafe
@ -99,15 +97,17 @@ M:: sfmt generate ( sfmt -- )
swap >>m swap >>m
swap >>n swap >>n
swap >>seed swap >>seed
dup [ m>> ] [ n>> ] bi - >>m-n
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 ;
: refill-sfmt? ( sfmt -- ? ) : refill-sfmt? ( sfmt -- ? )
state>> [ ix>> ] [ n>> 4 * ] bi >= ; state>> [ ix>> ] [ n>> 4 * ] bi >= ;
@ -121,8 +121,12 @@ M:: sfmt generate ( sfmt -- )
PRIVATE> PRIVATE>
M: sfmt random-32* ( sfmt -- n ) 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 ;
: <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> ; <sfmt> ; inline

1
extra/benchmark/sfmt/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

11
extra/benchmark/sfmt/sfmt.factor Normal file
View File

@ -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 <sfmt-19937> '[ _ random-32* drop ] times ;
: sfmt-main ( -- ) 100000000 sfmt-benchmark ;
MAIN: sfmt-main