fix seed-random, random-32* -> random-32
parent
bc5807b20a
commit
61583862fa
|
@ -4,8 +4,8 @@ IN: random.dummy
|
||||||
TUPLE: random-dummy i ;
|
TUPLE: random-dummy i ;
|
||||||
C: <random-dummy> random-dummy
|
C: <random-dummy> random-dummy
|
||||||
|
|
||||||
M: random-dummy seed-random ( seed obj -- )
|
M: random-dummy seed-random ( obj seed -- obj )
|
||||||
(>>i) ;
|
>>i ;
|
||||||
|
|
||||||
M: random-dummy random-32* ( obj -- r )
|
M: random-dummy random-32 ( obj -- r )
|
||||||
[ dup 1 + ] change-i drop ;
|
[ dup 1 + ] change-i drop ;
|
||||||
|
|
|
@ -16,14 +16,20 @@ IN: random.mersenne-twister.tests
|
||||||
[ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test
|
[ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test
|
||||||
|
|
||||||
[ 1333075495 ] [
|
[ 1333075495 ] [
|
||||||
0 [ 1000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng
|
0 [ 1000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ 1575309035 ] [
|
[ 1575309035 ] [
|
||||||
0 [ 10000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng
|
0 [ 10000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
[ 3 ] [ 101 [ 3 random-bytes length ] test-rng ] unit-test
|
[ 3 ] [ 101 [ 3 random-bytes length ] test-rng ] unit-test
|
||||||
[ 33 ] [ 101 [ 33 random-bytes length ] test-rng ] unit-test
|
[ 33 ] [ 101 [ 33 random-bytes length ] test-rng ] unit-test
|
||||||
[ t ] [ 101 [ 100 random-bits log2 90 > ] test-rng ] unit-test
|
[ t ] [ 101 [ 100 random-bits log2 90 > ] test-rng ] unit-test
|
||||||
|
|
||||||
|
[ t ]
|
||||||
|
[
|
||||||
|
1234 <mersenne-twister>
|
||||||
|
[ random-32 ] [ 1234 seed-random random-32 ] bi =
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -62,15 +62,21 @@ PRIVATE>
|
||||||
init-mt-seq 0 mersenne-twister boa
|
init-mt-seq 0 mersenne-twister boa
|
||||||
dup mt-generate ;
|
dup mt-generate ;
|
||||||
|
|
||||||
M: mersenne-twister seed-random ( mt seed -- )
|
M: mersenne-twister seed-random ( mt seed -- mt' )
|
||||||
init-mt-seq >>seq drop ;
|
init-mt-seq >>seq
|
||||||
|
[ mt-generate ]
|
||||||
|
[ 0 >>i drop ]
|
||||||
|
[ ] tri ;
|
||||||
|
|
||||||
M: mersenne-twister random-32* ( mt -- r )
|
M: mersenne-twister random-32 ( mt -- r )
|
||||||
[ next-index ]
|
[ next-index ]
|
||||||
[ seq>> nth-unsafe mt-temper ]
|
[ seq>> nth-unsafe mt-temper ]
|
||||||
[ [ 1 + ] change-i drop ] tri ;
|
[ [ 1 + ] change-i drop ] tri ;
|
||||||
|
|
||||||
[
|
: default-mersenne-twister ( -- mersenne-twister )
|
||||||
[ 32 random-bits ] with-system-random
|
[ 32 random-bits ] with-system-random
|
||||||
<mersenne-twister> random-generator set-global
|
<mersenne-twister> ;
|
||||||
|
|
||||||
|
[
|
||||||
|
default-mersenne-twister random-generator set-global
|
||||||
] "bootstrap.random" add-init-hook
|
] "bootstrap.random" add-init-hook
|
||||||
|
|
|
@ -2,11 +2,15 @@ USING: help.markup help.syntax math kernel sequences ;
|
||||||
IN: random
|
IN: random
|
||||||
|
|
||||||
HELP: seed-random
|
HELP: seed-random
|
||||||
{ $values { "tuple" "a random number generator" } { "seed" "an integer between 0 and 2^32-1" } }
|
{ $values
|
||||||
{ $description "Seed the random number generator." }
|
{ "tuple" "a random number generator" }
|
||||||
|
{ "seed" "a seed specific to the random number generator" }
|
||||||
|
{ "tuple'" "a random number generator" }
|
||||||
|
}
|
||||||
|
{ $description "Seed the random number generator. Repeatedly seeding the random number generator should provide the same sequence of random numbers." }
|
||||||
{ $notes "Not supported on all random number generators." } ;
|
{ $notes "Not supported on all random number generators." } ;
|
||||||
|
|
||||||
HELP: random-32*
|
HELP: random-32
|
||||||
{ $values { "tuple" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } }
|
{ $values { "tuple" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } }
|
||||||
{ $description "Generates a random 32-bit unsigned integer." } ;
|
{ $description "Generates a random 32-bit unsigned integer." } ;
|
||||||
|
|
||||||
|
@ -92,7 +96,7 @@ HELP: delete-random
|
||||||
|
|
||||||
ARTICLE: "random-protocol" "Random protocol"
|
ARTICLE: "random-protocol" "Random protocol"
|
||||||
"A random number generator must implement one of these two words:"
|
"A random number generator must implement one of these two words:"
|
||||||
{ $subsection random-32* }
|
{ $subsection random-32 }
|
||||||
{ $subsection random-bytes* }
|
{ $subsection random-bytes* }
|
||||||
"Optional, to seed a random number generator:"
|
"Optional, to seed a random number generator:"
|
||||||
{ $subsection seed-random } ;
|
{ $subsection seed-random } ;
|
||||||
|
|
|
@ -10,19 +10,19 @@ SYMBOL: system-random-generator
|
||||||
SYMBOL: secure-random-generator
|
SYMBOL: secure-random-generator
|
||||||
SYMBOL: random-generator
|
SYMBOL: random-generator
|
||||||
|
|
||||||
GENERIC: seed-random ( tuple seed -- )
|
GENERIC# seed-random 1 ( tuple seed -- tuple' )
|
||||||
GENERIC: random-32* ( tuple -- r )
|
GENERIC: random-32 ( tuple -- r )
|
||||||
GENERIC: random-bytes* ( n tuple -- byte-array )
|
GENERIC: random-bytes* ( n tuple -- byte-array )
|
||||||
|
|
||||||
M: object random-bytes* ( n tuple -- byte-array )
|
M: object random-bytes* ( n tuple -- byte-array )
|
||||||
[ [ <byte-vector> ] keep 4 /mod ] dip
|
[ [ <byte-vector> ] keep 4 /mod ] dip
|
||||||
[ pick '[ _ random-32* 4 >le _ push-all ] times ]
|
[ pick '[ _ random-32 4 >le _ push-all ] times ]
|
||||||
[
|
[
|
||||||
over zero?
|
over zero?
|
||||||
[ 2drop ] [ random-32* 4 >le swap head over push-all ] if
|
[ 2drop ] [ random-32 4 >le swap head over push-all ] if
|
||||||
] bi-curry bi* ;
|
] bi-curry bi* ;
|
||||||
|
|
||||||
M: object random-32* ( tuple -- r ) 4 random-bytes* le> ;
|
M: object random-32 ( tuple -- r ) 4 random-bytes* le> ;
|
||||||
|
|
||||||
ERROR: no-random-number-generator ;
|
ERROR: no-random-number-generator ;
|
||||||
|
|
||||||
|
@ -31,7 +31,7 @@ M: no-random-number-generator summary
|
||||||
|
|
||||||
M: f random-bytes* ( n obj -- * ) no-random-number-generator ;
|
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-bytes ( n -- byte-array )
|
: random-bytes ( n -- byte-array )
|
||||||
random-generator get random-bytes* ;
|
random-generator get random-bytes* ;
|
||||||
|
|
|
@ -4,7 +4,7 @@ grouping ;
|
||||||
IN: blum-blum-shub.tests
|
IN: blum-blum-shub.tests
|
||||||
|
|
||||||
[ 887708070 ] [
|
[ 887708070 ] [
|
||||||
T{ blum-blum-shub f 590695557939 811977232793 } clone random-32*
|
T{ blum-blum-shub f 590695557939 811977232793 } clone random-32
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
@ -23,7 +23,7 @@ IN: blum-blum-shub.tests
|
||||||
[ 3716213681 ]
|
[ 3716213681 ]
|
||||||
[
|
[
|
||||||
100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [
|
100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [
|
||||||
random-32* drop
|
random-32 drop
|
||||||
] curry times
|
] curry times
|
||||||
random-32*
|
random-32
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -25,6 +25,6 @@ PRIVATE>
|
||||||
[ find-relative-prime ] keep
|
[ find-relative-prime ] keep
|
||||||
blum-blum-shub boa ;
|
blum-blum-shub boa ;
|
||||||
|
|
||||||
M: blum-blum-shub random-32* ( bbs -- r )
|
M: blum-blum-shub random-32 ( bbs -- r )
|
||||||
0 32 rot
|
0 32 rot
|
||||||
[ next-bbs-bit swap 1 shift bitor ] curry times ;
|
[ next-bbs-bit swap 1 shift bitor ] curry times ;
|
||||||
|
|
Loading…
Reference in New Issue