random: some cleanup.
parent
c02fc27afc
commit
a718127fd1
|
@ -4,8 +4,8 @@ IN: random.dummy
|
|||
TUPLE: random-dummy i ;
|
||||
C: <random-dummy> random-dummy
|
||||
|
||||
M: random-dummy seed-random ( obj seed -- obj )
|
||||
M: random-dummy seed-random
|
||||
>>i ;
|
||||
|
||||
M: random-dummy random-32* ( obj -- r )
|
||||
M: random-dummy random-32*
|
||||
[ dup 1 + ] change-i drop ;
|
||||
|
|
|
@ -62,20 +62,19 @@ PRIVATE>
|
|||
init-mt-seq 0 mersenne-twister boa
|
||||
dup mt-generate ;
|
||||
|
||||
M: mersenne-twister seed-random ( mt seed -- mt' )
|
||||
M: mersenne-twister seed-random
|
||||
init-mt-seq >>seq
|
||||
[ mt-generate ]
|
||||
[ 0 >>i drop ]
|
||||
[ ] tri ;
|
||||
|
||||
M: mersenne-twister random-32* ( mt -- r )
|
||||
M: mersenne-twister random-32*
|
||||
[ next-index ]
|
||||
[ seq>> nth-unsafe mt-temper ]
|
||||
[ [ 1 + ] change-i drop ] tri ;
|
||||
|
||||
: default-mersenne-twister ( -- mersenne-twister )
|
||||
[ 32 random-bits ] with-system-random
|
||||
<mersenne-twister> ;
|
||||
[ random-32 ] with-system-random <mersenne-twister> ;
|
||||
|
||||
[
|
||||
default-mersenne-twister random-generator set-global
|
||||
|
|
|
@ -10,7 +10,7 @@ HELP: seed-random
|
|||
{ $notes "Not supported on all random number generators." } ;
|
||||
|
||||
HELP: random-32*
|
||||
{ $values { "obj" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } }
|
||||
{ $values { "obj" "a random number generator" } { "n" "an integer between 0 and 2^32-1" } }
|
||||
{ $description "Generates a random 32-bit unsigned integer." } ;
|
||||
|
||||
HELP: random-bytes*
|
||||
|
@ -78,11 +78,11 @@ HELP: random-units
|
|||
} ;
|
||||
|
||||
HELP: random-bits
|
||||
{ $values { "numbits" integer } { "r" "a random integer" } }
|
||||
{ $values { "numbits" integer } { "n" "a random integer" } }
|
||||
{ $description "Outputs an random integer n bits in length." } ;
|
||||
|
||||
HELP: random-bits*
|
||||
{ $values { "numbits" integer } { "r" "a random integer" } }
|
||||
{ $values { "numbits" integer } { "n" "a random integer" } }
|
||||
{ $description "Returns an integer exactly " { $snippet "numbits" } " in length, with the topmost bit set to one." } ;
|
||||
|
||||
HELP: with-random
|
||||
|
|
|
@ -15,10 +15,10 @@ SYMBOL: secure-random-generator
|
|||
SYMBOL: random-generator
|
||||
|
||||
GENERIC# seed-random 1 ( obj seed -- obj )
|
||||
GENERIC: random-32* ( obj -- r )
|
||||
GENERIC: random-32* ( obj -- n )
|
||||
GENERIC: random-bytes* ( n obj -- byte-array )
|
||||
|
||||
M: object random-bytes* ( n obj -- byte-array )
|
||||
M: object random-bytes*
|
||||
[ integer>fixnum-strict [ <byte-array> ] keep ] dip
|
||||
[ over 4 >= ] [
|
||||
[ 4 - ] dip
|
||||
|
@ -27,7 +27,7 @@ M: object random-bytes* ( n obj -- byte-array )
|
|||
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 ;
|
||||
|
@ -47,7 +47,7 @@ M: f random-32* ( obj -- * ) no-random-number-generator ;
|
|||
|
||||
<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*
|
||||
|
@ -60,27 +60,27 @@ M: f random-32* ( obj -- * ) no-random-number-generator ;
|
|||
|
||||
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)) ( 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) ( m obj -- n ) ((random-integer)) ;
|
||||
M: bignum (random-integer) ( m obj -- n ) ((random-integer)) ;
|
||||
|
||||
: random-integer ( n -- r )
|
||||
: random-integer ( m -- n )
|
||||
random-generator get (random-integer) ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
|
@ -25,6 +25,6 @@ PRIVATE>
|
|||
[ find-relative-prime ] keep
|
||||
blum-blum-shub boa ;
|
||||
|
||||
M: blum-blum-shub random-32* ( bbs -- r )
|
||||
M: blum-blum-shub random-32*
|
||||
0 32 rot
|
||||
[ next-bbs-bit swap 1 shift bitor ] curry times ;
|
||||
|
|
Loading…
Reference in New Issue