{ "compare-slots" { "compare-with-spec" "0.99" } }
{ "natural-sort!" { "sort!" "0.99" } }
{ "natural-bubble-sort!" { "bubble-sort!" "0.99" } }
+ { "random-integers" { "randoms" "0.99" } }
}
: compute-assoc-fixups ( continuation name assoc -- seq )
HELP: seed-random
{ $values
- { "obj" "a random number generator" }
+ { "rnd" "a random number generator" }
{ "seed" "a seed specific to the 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." } ;
HELP: random-32*
-{ $values { "obj" "a random number generator" } { "n" "an integer between 0 and 2^32-1" } }
+{ $values { "rnd" "a random number generator" } { "n" "an integer between 0 and 2^32-1" } }
{ $description "Generates a random 32-bit unsigned integer." } ;
+HELP: random-32
+{ $values { "n" "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." } ;
+
+{ random-32* random-32 } related-words
+
HELP: random-bytes*
-{ $values { "n" integer } { "obj" "a random number generator" } { "byte-array" "a sequence of random bytes" } }
+{ $values { "n" integer } { "rnd" "a random number generator" } { "byte-array" "a sequence of random bytes" } }
{ $description "Generates a byte-array of " { $snippet "n" } " random bytes." } ;
+HELP: random-bytes
+{ $values { "n" integer } { "byte-array" "a sequence of random bytes" } }
+{ $description "Generates a byte-array of " { $snippet "n" } " random bytes." }
+{ $examples
+ { $unchecked-example "USING: prettyprint random ;"
+ "5 random-bytes ."
+ "B{ 135 50 185 119 240 }"
+ }
+} ;
+
+{ random-bytes* random-bytes } related-words
+
+HELP: random*
+{ $values { "obj" object } { "rnd" "a random number generator" } { "elt" "a random element" } }
+{ $description "Outputs a random element of the input object, or outputs " { $link f } " if the object contains no elements." } ;
+
HELP: random
{ $values { "obj" object } { "elt" "a random element" } }
{ $description "Outputs a random element of the input object, or outputs " { $link f } " if the object contains no elements." }
"heads" }
} ;
-HELP: random-32
-{ $values { "n" "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" integer } { "byte-array" "a sequence of random bytes" } }
-{ $description "Generates a byte-array of " { $snippet "n" } " random bytes." }
-{ $examples
- { $unchecked-example "USING: prettyprint random ;"
- "5 random-bytes ."
- "B{ 135 50 185 119 240 }"
- }
-} ;
-
-HELP: random-integers
-{ $values { "length" integer } { "n" integer } { "sequence" array } }
-{ $description "Outputs an array with " { $snippet "length" } " random integers from [0,n)." }
+HELP: randoms
+{ $values { "length" integer } { "obj" object } { "seq" array } }
+{ $description "Outputs an array with " { $snippet "length" } " random values generated from " { $snippet "obj" } "." }
{ $examples
{ $unchecked-example "USING: prettyprint random ;"
- "10 100 random-integers ."
+ "10 100 randoms ."
"{ 32 62 71 89 54 12 57 57 10 19 }"
}
} ;
+{ random* random randoms } related-words
+
HELP: random-unit
{ $values { "n" float } }
{ $description "Outputs a random uniform float from [0,1]." } ;
{ $description "Returns an integer exactly " { $snippet "numbits" } " bits in length, with the topmost bit set to one." } ;
HELP: with-random
-{ $values { "obj" "a random number generator" } { "quot" quotation } }
+{ $values { "rnd" "a random number generator" } { "quot" quotation } }
{ $description "Calls the quotation with the random number generator in a dynamic variable. All random numbers will be generated using this random number generator." } ;
HELP: with-secure-random
$nl
"The “Mersenne Twister” pseudorandom number generator algorithm is the default generator stored in " { $link random-generator } "."
$nl
-"Generate a random object:"
-{ $subsections random }
+"Generate random object(s):"
+{ $subsections random randoms }
"Efficient 32-bit random numbers:"
{ $subsections random-32 }
"Combinators to change the random number generator:"
"Deleting a random element from a sequence:"
{ $subsections delete-random }
"Sequences of random numbers:"
-{ $subsections random-bytes random-integers random-units }
+{ $subsections random-bytes random-units }
"Random numbers with " { $snippet "n" } " bits:"
{ $subsections
random-bits
math.functions math.order namespaces sequences sequences.private
sets summary system vocabs ;
QUALIFIED-WITH: alien.c-types c
-QUALIFIED-WITH: sets sets
IN: random
+USE: kernel.private
+
SYMBOL: system-random-generator
SYMBOL: secure-random-generator
SYMBOL: random-generator
-GENERIC#: seed-random 1 ( obj seed -- obj )
-GENERIC: random-32* ( obj -- n )
-GENERIC: random-bytes* ( n obj -- byte-array )
+GENERIC#: seed-random 1 ( rnd seed -- rnd )
+GENERIC: random-32* ( rnd -- n )
+GENERIC: random-bytes* ( n rnd -- byte-array )
M: object random-bytes*
[ integer>fixnum-strict [ (byte-array) ] keep ] dip
<PRIVATE
-:: (random-bits) ( numbits obj -- n )
+:: (random-bits) ( numbits rnd -- n )
numbits 32 > [
- obj random-32* numbits 32 - [ dup 32 > ] [
- [ 32 shift obj random-32* + ] [ 32 - ] bi*
+ rnd random-32* numbits 32 - [ dup 32 > ] [
+ [ 32 shift rnd random-32* + ] [ 32 - ] bi*
] while [
- [ shift ] keep obj random-32* swap bits +
+ [ shift ] keep rnd random-32* swap bits +
] unless-zero
] [
- obj random-32* numbits bits
+ rnd random-32* numbits bits
] if ; inline
PRIVATE>
: random-bits* ( numbits -- n )
1 - [ random-bits ] keep set-bit ;
+GENERIC#: random* 1 ( obj rnd -- elt )
+
+: random ( obj -- elt )
+ random-generator get random* ;
+
+: randoms ( length obj -- seq )
+ random-generator get '[ _ _ random* ] replicate ;
+
<PRIVATE
: next-power-of-2-bits ( m -- numbits )
dup 2 <= [ drop 1 ] [ 1 - log2 1 + ] if ; inline
-:: 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 [ m * ] [ neg shift ] bi* ; inline
-
-GENERIC#: (random-integer) 1 ( m obj -- n )
-M: fixnum (random-integer) random-integer-loop ;
-M: bignum (random-integer) random-integer-loop ;
-
-: random-integer ( m -- n )
- random-generator get (random-integer) ;
+:: random-integer ( m rnd -- n )
+ m zero? [ f ] [
+ rnd random-32* { integer } declare 32 m next-power-of-2-bits 32 - [ dup 0 > ] [
+ [ 32 shift rnd random-32* { integer } declare + ] [ 32 + ] [ 32 - ] tri*
+ ] while drop [ m * ] [ neg shift ] bi*
+ ] if ; inline
PRIVATE>
-GENERIC: random ( obj -- elt )
+M: fixnum random* random-integer ;
-M: integer random
- [ f ] [ random-integer ] if-zero ;
+M: bignum random* random-integer ;
-M: sequence random
- [ f ] [
- [ length random-integer ] keep nth
- ] if-empty ;
+M: sequence random*
+ [ f ] swap '[ [ length _ random* ] keep nth ] if-empty ;
-M: assoc random >alist random ;
+M: assoc random* [ >alist ] dip random* ;
-M: hashtable random
- dup assoc-size [ drop f ] [
- [ 0 ] [ array>> ] [ random ] tri* 1 + [
+M: hashtable random*
+ [ dup assoc-size [ drop f ] ] dip '[
+ [ 0 ] [ array>> ] [ _ random* ] tri* 1 + [
[ 2dup array-nth tombstone? [ 2 + ] 2dip ] loop
] times [ 2 - ] dip
[ array-nth ] [ [ 1 + ] dip array-nth ] 2bi 2array
] if-zero ;
-M: sets:set random members random ;
+M: sets:set random* [ members ] dip random* ;
-M: hash-set random
- dup cardinality [ drop f ] [
- [ 0 ] [ array>> ] [ random ] tri* 1 + [
+M: hash-set random*
+ [ dup cardinality [ drop f ] ] dip '[
+ [ 0 ] [ array>> ] [ _ random* ] tri* 1 + [
[ 2dup array-nth tombstone? [ 1 + ] 2dip ] loop
] times [ 1 - ] dip array-nth
] if-zero ;
: randomize-n-last ( seq n -- seq )
[ dup length dup ] dip - 1 max '[ dup _ > ]
random-generator get '[
- [ _ (random-integer) ] [ 1 - ] bi
+ [ _ random* ] [ 1 - ] bi
[ pick exchange-unsafe ] keep
] while drop ;
[ drop ] 2bi nths-unsafe ;
: delete-random ( seq -- elt )
- [ length random-integer ] keep
- [ nth ] 2keep remove-nth! drop ;
+ [ length random ] keep [ nth ] 2keep remove-nth! drop ;
-: with-random ( obj quot -- )
+: with-random ( rnd quot -- )
random-generator swap with-variable ; inline
: with-system-random ( quot -- )
<PRIVATE
-: (uniform-random-float) ( min max obj -- n )
+: (uniform-random-float) ( min max rnd -- n )
[ random-32* ] keep random-32* [ >float ] bi@
2.0 32 ^ * +
[ over - 2.0 -64 ^ * ] dip
: uniform-random-float ( min max -- n )
random-generator get (uniform-random-float) ; inline
-M: float random [ f ] [ 0.0 swap uniform-random-float ] if-zero ;
+M: float random*
+ [ f ] swap '[ 0.0 _ (uniform-random-float) ] if-zero ; inline
<PRIVATE
-: (random-unit) ( obj -- n )
+! XXX: rename to random-unit*
+: (random-unit) ( rnd -- n )
[ 0.0 1.0 ] dip (uniform-random-float) ; inline
PRIVATE>
: random-units ( length -- sequence )
random-generator get '[ _ (random-unit) ] replicate ;
-: random-integers ( length n -- sequence )
- random-generator get '[ _ _ (random-integer) ] replicate ;
-
<PRIVATE
: (cos-random-float) ( -- n )
IN: benchmark.parse-ratio
CONSTANT: test-ratios $[
- 200,000 100,000 random-integers
- 200,000 1,000 random-integers 1 v+n v/
+ 200,000 100,000 randoms
+ 200,000 1,000 randoms 1 v+n v/
]
: parse-ratio-benchmark ( -- )
USING: assocs kernel literals math random sequences sorting ;
IN: benchmark.sort
-CONSTANT: numbers-to-sort $[ 300,000 200 random-integers ]
+CONSTANT: numbers-to-sort $[ 300,000 200 randoms ]
CONSTANT: alist-to-sort $[ 1,000 <iota> dup zip ]
: sort-benchmark ( -- )
IN: benchmark.unicode
: crazy-unicode-string ( -- string )
- 8 [ 8 0xffff random-integers ] replicate join-words ;
+ 8 [ 8 0xffff randoms ] replicate join-words ;
: unicode-benchmark ( -- )
crazy-unicode-string 8 [
M: random-stream stream-read-unsafe
drop [ dup random-bytes ] [ 0 swap copy-unsafe ] bi* ;
-M: random-stream stream-read1 drop 256 random-integer ;
+M: random-stream stream-read1 drop 256 random ;
M: random-stream stream-read-partial-unsafe stream-read-unsafe ;
: weighted-random ( histogram -- obj )
unzip cum-sum [ last >float random ] [ bisect-left ] bi swap nth ;
-: weighted-randoms ( length histogram -- seq )
- unzip swap [ cum-sum [ last >float random-generator get ] keep ] dip
- '[ 0.0 _ _ (uniform-random-float) _ bisect-left _ nth ] replicate ;
+: weighted-randoms ( histogram length -- seq )
+ swap unzip swap [ cum-sum [ last >float random-generator get ] keep ] dip
+ '[ _ _ random* _ bisect-left _ nth ] replicate ;
: unique-indices ( seq -- unique indices )
[ members ] keep over dup length <iota>
HELP: <random-integer-matrix>
{ $values { "m" integer } { "n" integer } { "max" integer } { "matrix" matrix } }
-{ $description "Creates a " { $snippet "m x n" } " " { $link matrix } " full of random, possibly signed " { $link integer } "s whose absolute values are less than or equal to " { $snippet "max" } ", as given by " { $link random-integers } "." }
+{ $description "Creates a " { $snippet "m x n" } " " { $link matrix } " full of random, possibly signed " { $link integer } "s whose absolute values are less than or equal to " { $snippet "max" } ", as given by " { $link randoms } "." }
{ $notelist
{ "The signedness of the numbers in the resulting matrix will be randomized. Use " { $link mabs } " with this word to generate a matrix of random positive integers." }
{ $equiv-word-note "integral" <random-unit-matrix> }
PRIVATE>
: <random-integer-matrix> ( m n max -- matrix )
- '[ _ _ 1 + random-integers ] replicate
+ '[ _ _ 1 + randoms ] replicate
finish-randomizing-matrix ; inline
: <random-unit-matrix> ( m n max -- matrix )
projects / factor.git / commitdiff