diff --git a/basis/random/dummy/dummy-tests.factor b/basis/random/dummy/dummy-tests.factor index 1fa81c4d6e..5d4b4b5473 100644 --- a/basis/random/dummy/dummy-tests.factor +++ b/basis/random/dummy/dummy-tests.factor @@ -3,5 +3,5 @@ USING: random random.dummy tools.test ; IN: random.dummy.tests -[ 10 ] [ 10 random-32 ] unit-test -[ 100 ] [ 10 100 seed-random random-32 ] unit-test +[ 10 ] [ 10 random-32* ] unit-test +[ 100 ] [ 10 100 seed-random random-32* ] unit-test diff --git a/basis/random/dummy/dummy.factor b/basis/random/dummy/dummy.factor index 5763570d75..988bd015d0 100644 --- a/basis/random/dummy/dummy.factor +++ b/basis/random/dummy/dummy.factor @@ -7,5 +7,5 @@ C: random-dummy M: random-dummy seed-random ( obj seed -- obj ) >>i ; -M: random-dummy random-32 ( obj -- r ) +M: random-dummy random-32* ( obj -- r ) [ dup 1 + ] change-i drop ; diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor index 30caa56059..b877af6f79 100644 --- a/basis/random/mersenne-twister/mersenne-twister-tests.factor +++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor @@ -16,11 +16,11 @@ IN: random.mersenne-twister.tests [ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test [ 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 [ 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 @@ -31,5 +31,5 @@ IN: random.mersenne-twister.tests [ t ] [ 1234 - [ random-32 ] [ 1234 seed-random random-32 ] bi = + [ random-32* ] [ 1234 seed-random random-32* ] bi = ] unit-test diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor index 0e65e195e4..51112ae980 100644 --- a/basis/random/mersenne-twister/mersenne-twister.factor +++ b/basis/random/mersenne-twister/mersenne-twister.factor @@ -68,7 +68,7 @@ M: mersenne-twister seed-random ( mt seed -- mt' ) [ 0 >>i drop ] [ ] tri ; -M: mersenne-twister random-32 ( mt -- r ) +M: mersenne-twister random-32* ( mt -- r ) [ next-index ] [ seq>> nth-unsafe mt-temper ] [ [ 1 + ] change-i drop ] tri ; diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index a297df9fd6..79e38ec3b6 100755 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -10,7 +10,7 @@ HELP: seed-random { $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." } ; -HELP: random-32 +HELP: random-32* { $values { "tuple" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } } { $description "Generates a random 32-bit unsigned integer." } ; @@ -33,6 +33,10 @@ HELP: random "heads" } } ; +HELP: random-32 +{ $values { "elt" "a 32-bit random integer" } } +{ $description "Outputs 32 random bits. This word is more efficient than calling " { $link random } " because no scaling is done on the output." } ; + HELP: random-bytes { $values { "n" "an integer" } { "byte-array" "a random integer" } } { $description "Outputs an integer with n bytes worth of bits." } @@ -96,7 +100,7 @@ HELP: delete-random ARTICLE: "random-protocol" "Random protocol" "A random number generator must implement one of these two words:" -{ $subsection random-32 } +{ $subsection random-32* } { $subsection random-bytes* } "Optional, to seed a random number generator:" { $subsection seed-random } ; @@ -108,6 +112,8 @@ $nl $nl "Generate a random object:" { $subsection random } +"Efficient 32-bit random numbers:" +{ $subsection random-32 } "Combinators to change the random number generator:" { $subsection with-random } { $subsection with-system-random } diff --git a/basis/random/random.factor b/basis/random/random.factor index db15f78ee1..1f2408556f 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -11,18 +11,18 @@ SYMBOL: secure-random-generator SYMBOL: random-generator GENERIC# seed-random 1 ( tuple seed -- tuple' ) -GENERIC: random-32 ( tuple -- r ) +GENERIC: random-32* ( tuple -- r ) GENERIC: random-bytes* ( n tuple -- byte-array ) M: object random-bytes* ( n tuple -- byte-array ) [ [ ] keep 4 /mod ] dip - [ pick '[ _ random-32 4 >le _ push-all ] times ] + [ pick '[ _ random-32* 4 >le _ push-all ] times ] [ 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* ; -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 ; @@ -31,7 +31,7 @@ M: no-random-number-generator summary 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-generator get random-bytes* ; @@ -55,6 +55,8 @@ PRIVATE> [ length random-integer ] keep nth ] if-empty ; +: random-32 ( -- n ) random-generator get random-32* ; + : randomize ( seq -- seq ) dup length [ dup 1 > ] [ [ iota random ] [ 1 - ] bi [ pick exchange ] keep ] diff --git a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor index 5b05b09a4c..4b0dee642e 100644 --- a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor @@ -4,7 +4,7 @@ grouping ; IN: blum-blum-shub.tests [ 887708070 ] [ - T{ blum-blum-shub f 590695557939 811977232793 } clone random-32 + T{ blum-blum-shub f 590695557939 811977232793 } clone random-32* ] unit-test @@ -23,7 +23,7 @@ IN: blum-blum-shub.tests [ 3716213681 ] [ 100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [ - random-32 drop + random-32* drop ] curry times - random-32 + random-32* ] unit-test diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor index 9f504cefb5..8229abca69 100755 --- a/extra/random/blum-blum-shub/blum-blum-shub.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub.factor @@ -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* ( bbs -- r ) 0 32 rot [ next-bbs-bit swap 1 shift bitor ] curry times ;