random: implement a generic random* to speed up randoms

factor · Feb 26, 2023 · 930bc25 · 930bc25
1 parent 610673a
commit 930bc25
Show file tree

Hide file tree

Showing 10 changed files with 90 additions and 80 deletions.
diff --git a/basis/fixups/fixups.factor b/basis/fixups/fixups.factor
@@ -59,6 +59,7 @@ CONSTANT: word-renames {
     { "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 )

diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor
@@ -4,20 +4,42 @@ IN: combinators.random
 
 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." }
@@ -32,30 +54,18 @@ HELP: random
         "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]." } ;
@@ -87,7 +97,7 @@ HELP: random-bits*
 { $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
@@ -140,8 +150,8 @@ ARTICLE: "random" "Generating random integers"
 $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:"
@@ -159,7 +169,7 @@ $nl
 "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

diff --git a/basis/random/random.factor b/basis/random/random.factor
@@ -6,16 +6,17 @@ hashtables.private kernel math math.bitwise math.constants
 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
@@ -46,15 +47,15 @@ M: f random-32* no-random-number-generator ;
 
 <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>
@@ -65,58 +66,58 @@ 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 ;
 
@@ -131,10 +132,9 @@ ERROR: too-many-samples seq n ;
     [ 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 -- )
@@ -145,7 +145,7 @@ ERROR: too-many-samples seq n ;
 
 <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
@@ -156,11 +156,13 @@ PRIVATE>
 : 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>
@@ -171,9 +173,6 @@ 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 )

diff --git a/extra/benchmark/parse-ratio/parse-ratio.factor b/extra/benchmark/parse-ratio/parse-ratio.factor
@@ -3,8 +3,8 @@ sequences ;
 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 ( -- )

diff --git a/extra/benchmark/sort/sort.factor b/extra/benchmark/sort/sort.factor
@@ -1,7 +1,7 @@
 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 ( -- )

diff --git a/extra/benchmark/unicode/unicode.factor b/extra/benchmark/unicode/unicode.factor
@@ -4,7 +4,7 @@ USING: kernel math random sequences splitting unicode ;
 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 [

diff --git a/extra/io/streams/random/random.factor b/extra/io/streams/random/random.factor
@@ -14,7 +14,7 @@ M: random-stream stream-element-type drop +byte+ ;
 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 ;
 

diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
@@ -202,9 +202,9 @@ PRIVATE>
 : 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>

diff --git a/extra/math/matrices/extras/extras-docs.factor b/extra/math/matrices/extras/extras-docs.factor
@@ -112,7 +112,7 @@ HELP: undefined-inverse
 
 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> }

diff --git a/extra/math/matrices/extras/extras.factor b/extra/math/matrices/extras/extras.factor
@@ -31,7 +31,7 @@ DEFER: alternating-sign
 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 )