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

random: random integers is 90% faster.

db4
John Benediktsson 2011-10-14 18:52:41 -07:00
parent d773d99de5
commit 37deaec528
1 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/random/random.factor
View File

@ -3,8 +3,8 @@
USING: accessors alien.c-types alien.data arrays assocs USING: accessors alien.c-types alien.data arrays assocs
byte-arrays byte-vectors combinators fry io.backend io.binary byte-arrays byte-vectors combinators fry io.backend io.binary
kernel locals math math.bitwise math.constants math.functions kernel locals math math.bitwise math.constants math.functions
math.order math.ranges namespaces sequences sets summary system math.order math.ranges namespaces sequences sequences.private
vocabs.loader ; sets summary system vocabs.loader ;
IN: random IN: random
SYMBOL: system-random-generator SYMBOL: system-random-generator
@ -34,15 +34,21 @@ M: f random-bytes* ( n obj -- * ) no-random-number-generator ;
M: f random-32* ( obj -- * ) no-random-number-generator ; M: f random-32* ( obj -- * ) no-random-number-generator ;
: random-32 ( -- n ) random-generator get random-32* ;
: random-bytes ( n -- byte-array ) : random-bytes ( n -- byte-array )
random-generator get random-bytes* ; random-generator get random-bytes* ;
<PRIVATE <PRIVATE
: (random-integer) ( bits -- n required-bits )
[ random-32 32 ] dip 32 - [ dup 0 > ] [
[ 32 shift random-32 + ] [ 32 + ] [ 32 - ] tri*
] while drop ;
: random-integer ( n -- n' ) : random-integer ( n -- n' )
dup log2 7 + 8 /i 1 + dup next-power-of-2 log2 (random-integer)
[ random-bytes be> ] [ * ] [ 2^ /i ] bi* ;
[ 3 shift 2^ ] bi / * >integer ;
PRIVATE> PRIVATE>
@ -60,11 +66,9 @@ M: sequence random
[ length random-integer ] keep nth [ length random-integer ] keep nth
] if-empty ; ] if-empty ;
: random-32 ( -- n ) random-generator get random-32* ;
: randomize-n-last ( seq n -- seq ) : randomize-n-last ( seq n -- seq )
[ dup length dup ] dip - 1 max '[ dup _ > ] [ dup length dup ] dip - 1 max '[ dup _ > ]
[ [ random ] [ 1 - ] bi [ pick exchange ] keep ] [ [ random ] [ 1 - ] bi [ pick exchange-unsafe ] keep ]
while drop ; while drop ;
: randomize ( seq -- randomized ) : randomize ( seq -- randomized )