From 6b3b48a106405c482a2ecc9bbe58f40fb4fd7b06 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 11:44:12 -0500 Subject: [PATCH] random is generic, better random docs, cleanups --- .../mersenne-twister-tests.factor | 8 ++-- basis/random/random-docs.factor | 46 +++++++++++++++---- basis/random/random-tests.factor | 6 ++- basis/random/random.factor | 40 +++++++++++----- 4 files changed, 74 insertions(+), 26 deletions(-) diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor index 3f0ebf692a..8a2a5031fa 100644 --- a/basis/random/mersenne-twister/mersenne-twister-tests.factor +++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor @@ -3,17 +3,17 @@ random.mersenne-twister sequences tools.test math.order ; IN: random.mersenne-twister.tests : check-random ( max -- ? ) - dup >r random 0 r> between? ; + [ random 0 ] keep between? ; [ t ] [ 100 [ drop 674 check-random ] all? ] unit-test -: make-100-randoms - [ 100 [ 100 random , ] times ] { } make ; +: randoms ( -- seq ) + 100 [ 100 random ] replicate ; : test-rng ( seed quot -- ) >r r> with-random ; -[ f ] [ 1234 [ make-100-randoms make-100-randoms = ] test-rng ] unit-test +[ 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 diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index 74751328d5..c5daee783e 100644 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -1,12 +1,6 @@ -USING: help.markup help.syntax math ; +USING: help.markup help.syntax math kernel sequences ; IN: random -ARTICLE: "random-numbers" "Generating random integers" -"The " { $vocab-link "random" } " vocabulary implements the ``Mersenne Twister'' pseudo-random number generator algorithm." -{ $subsection random } ; - -ABOUT: "random-numbers" - HELP: seed-random { $values { "tuple" "a random number generator" } { "seed" "an integer between 0 and 2^32-1" } } { $description "Seed the random number generator." } @@ -21,8 +15,8 @@ HELP: random-bytes* { $description "Generates a byte-array of random bytes." } ; HELP: random -{ $values { "seq" "a sequence" } { "elt" "a random element" } } -{ $description "Outputs a random element of the sequence. If the sequence is empty, always outputs " { $link f } "." } +{ $values { "obj" object } { "elt" "a random element" } } +{ $description "Outputs a random element of the input object. If the object is an integer, an input of zero always returns a zero, a negative integer throws an error, and positive integers yield a random integer in the interval " { $snippet "[0,n)" } ". On a sequence, an empty sequence always outputs " { $link f } " while any other sequence outputs a random element." } { $notes "Since integers are sequences, passing an integer " { $snippet "n" } " yields a random integer in the interval " { $snippet "[0,n)" } "." } ; HELP: random-bytes @@ -47,4 +41,36 @@ HELP: with-secure-random { $values { "quot" "a quotation" } } { $description "Calls the quotation with the secure random generator in a dynamic variable. All random numbers will be generated using this random generator." } ; -{ with-random with-secure-random } related-words +HELP: with-system-random +{ $values { "quot" "a quotation" } } +{ $description "Calls the quotation with the system's random generator in a dynamic variable. All random numbers will be generated using this random generator." } ; + +{ with-random with-secure-random with-system-random } related-words + +HELP: delete-random +{ $values + { "seq" sequence } + { "elt" object } } +{ $description "Delete a random number from a sequence using " { $link delete-nth } " and returns the deleted object." } ; + +ARTICLE: "random-protocol" "Random protocol" +"A random number generator must implement one of these two words:" +{ $subsection random-32* } +{ $subsection random-bytes* } +"Optional, to seed a random number generator:" +{ $subsection seed-random } ; + +ARTICLE: "random" "Generating random integers" +"The " { $vocab-link "random" } " vocabulary contains a protocol for generating random or pseudorandom numbers. The ``Mersenne Twister'' pseudorandom number generator algorithm is the default generator stored in " { $link random-generator } "." +"Generate a random object:" +{ $subsection random } +"Combinators to change the random number generator:" +{ $subsection with-random } +{ $subsection with-system-random } +{ $subsection with-secure-random } +"Implementation:" +{ $subsection "random-protocol" } +"Deleting a random element from a sequence:" +{ $subsection delete-random } ; + +ABOUT: "random" diff --git a/basis/random/random-tests.factor b/basis/random/random-tests.factor index 89c0c02c4a..7300a0dac4 100644 --- a/basis/random/random-tests.factor +++ b/basis/random/random-tests.factor @@ -1,5 +1,5 @@ USING: random sequences tools.test kernel math math.functions -sets ; +sets math.constants ; IN: random.tests [ 4 ] [ 4 random-bytes length ] unit-test @@ -15,3 +15,7 @@ IN: random.tests [ t ] [ 10000 [ 0 [ drop 400 random + ] reduce ] keep / 2 * 400 10 ~ ] unit-test [ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test + +[ t ] [ pi random float? ] unit-test + +[ 0 ] [ 0 random ] unit-test diff --git a/basis/random/random.factor b/basis/random/random.factor index 5ee45e6729..673a97caa3 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -33,20 +33,38 @@ M: f random-32* ( obj -- * ) no-random-number-generator ; random-generator get random-bytes* ] keep head ; -: random ( seq -- elt ) - [ f ] [ - [ - length dup log2 7 + 8 /i 1+ - [ random-bytes byte-array>bignum ] - [ 3 shift 2^ ] bi / * >integer - ] keep nth - ] if-empty ; - -: delete-random ( seq -- elt ) - [ length random ] keep [ nth ] 2keep delete-nth ; +GENERIC: random ( obj -- elt ) : random-bits ( n -- r ) 2^ random ; +bignum ] + [ 3 shift 2^ ] bi / * >integer ; + +PRIVATE> + +M: sequence random ( seq -- elt ) + [ f ] [ + [ length random-integer ] keep nth + ] if-empty ; + +ERROR: negative-random n ; +M: integer random ( integer -- integer' ) + { + { [ dup 0 = ] [ ] } + { [ dup 0 < ] [ negative-random ] } + [ random-integer ] + } cond ; + +M: float random ( float -- elt ) + 64 random-bits 64 2^ 1- / * ; + +: delete-random ( seq -- elt ) + [ length random-integer ] keep [ nth ] 2keep delete-nth ; + : with-random ( tuple quot -- ) random-generator swap with-variable ; inline