! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.data arrays assocs byte-arrays
-byte-vectors combinators combinators.short-circuit fry
-hashtables hashtables.private hash-sets hints io.backend
-io.binary kernel locals math math.bitwise math.constants
-math.functions math.order math.ranges namespaces sequences
-sequences.private sets summary system typed vocabs ;
+combinators combinators.short-circuit hash-sets hashtables
+hashtables.private kernel math math.bitwise math.constants
+math.functions math.order namespaces sequences sequences.private
+sets summary system vocabs ;
QUALIFIED-WITH: alien.c-types c
QUALIFIED-WITH: sets sets
IN: random
SYMBOL: secure-random-generator
SYMBOL: random-generator
-GENERIC# seed-random 1 ( obj seed -- obj )
-GENERIC: random-32* ( obj -- r )
+GENERIC#: seed-random 1 ( obj seed -- obj )
+GENERIC: random-32* ( obj -- n )
GENERIC: random-bytes* ( n obj -- byte-array )
-M: object random-bytes* ( n obj -- byte-array )
- [ integer>fixnum-strict [ <byte-array> ] keep ] dip
+M: object random-bytes*
+ [ integer>fixnum-strict [ (byte-array) ] keep ] dip
[ over 4 >= ] [
[ 4 - ] dip
[ random-32* 2over c:int c:set-alien-value ] keep
random-32* c:int <ref> swap head 0 pick copy-unsafe
] if ;
-M: object random-32* ( obj -- r )
+M: object random-32*
4 swap random-bytes* c:uint deref ;
ERROR: no-random-number-generator ;
M: no-random-number-generator summary
drop "Random number generator is not defined." ;
-M: f random-bytes* ( n obj -- * ) no-random-number-generator ;
+M: f random-bytes* no-random-number-generator ;
-M: f random-32* ( obj -- * ) no-random-number-generator ;
+M: f random-32* no-random-number-generator ;
: random-32 ( -- n )
random-generator get random-32* ;
<PRIVATE
-:: (random-bits) ( numbits obj -- r )
+:: (random-bits) ( numbits obj -- n )
numbits 32 > [
obj random-32* numbits 32 - [ dup 32 > ] [
[ 32 shift obj random-32* + ] [ 32 - ] bi*
PRIVATE>
-: random-bits ( numbits -- r )
+: random-bits ( numbits -- n )
random-generator get (random-bits) ;
-: random-bits* ( numbits -- r )
+: random-bits* ( numbits -- n )
1 - [ random-bits ] keep set-bit ;
<PRIVATE
-: next-power-of-2-bits ( n -- numbits )
+: next-power-of-2-bits ( m -- numbits )
dup 2 <= [ drop 1 ] [ 1 - log2 1 + ] if ; inline
-:: ((random-integer)) ( n obj -- r )
- obj random-32* 32 n next-power-of-2-bits 32 - [ dup 0 > ] [
+:: random-integer-loop ( m obj -- n )
+ obj random-32* 32 m next-power-of-2-bits 32 - [ dup 0 > ] [
[ 32 shift obj random-32* + ] [ 32 + ] [ 32 - ] tri*
- ] while drop [ n * ] [ neg shift ] bi* ; inline
+ ] while drop [ m * ] [ neg shift ] bi* ; inline
-GENERIC# (random-integer) 1 ( n obj -- r )
-M: fixnum (random-integer) ( n obj -- r ) ((random-integer)) ;
-M: bignum (random-integer) ( n obj -- r ) ((random-integer)) ;
+GENERIC#: (random-integer) 1 ( m obj -- n )
+M: fixnum (random-integer) random-integer-loop ;
+M: bignum (random-integer) random-integer-loop ;
-: random-integer ( n -- r )
+: random-integer ( m -- n )
random-generator get (random-integer) ;
PRIVATE>
: sample ( seq n -- seq' )
2dup [ length ] dip < [ too-many-samples ] when
- [ [ length iota >array ] dip [ randomize-n-last ] keep tail-slice* ]
+ [ [ length <iota> >array ] dip [ randomize-n-last ] keep tail-slice* ]
[ drop ] 2bi nths-unsafe ;
: delete-random ( seq -- elt )