diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index 0270749d49..441aea15b2 100644 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -3,19 +3,18 @@ IN: random HELP: seed-random { $values - { "tuple" "a random number generator" } + { "obj" "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." } ; HELP: random-32* -{ $values { "tuple" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } } +{ $values { "obj" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } } { $description "Generates a random 32-bit unsigned integer." } ; HELP: random-bytes* -{ $values { "n" "an integer" } { "tuple" "a random number generator" } { "byte-array" "a sequence of random bytes" } } +{ $values { "n" "an integer" } { "obj" "a random number generator" } { "byte-array" "a sequence of random bytes" } } { $description "Generates a byte-array of random bytes." } ; HELP: random @@ -83,23 +82,20 @@ HELP: random-bits { $description "Outputs an random integer n bits in length." } ; HELP: random-bits* -{ $values - { "numbits" integer } - { "n" integer } -} +{ $values { "numbits" integer } { "r" "a random integer" } } { $description "Returns an integer exactly " { $snippet "numbits" } " in length, with the topmost bit set to one." } ; HELP: with-random -{ $values { "tuple" "a random generator" } { "quot" "a quotation" } } -{ $description "Calls the quotation with the random generator in a dynamic variable. All random numbers will be generated using this random generator." } ; +{ $values { "obj" "a random number generator" } { "quot" "a 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 { $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." } ; +{ $description "Calls the quotation with the secure random number generator in a dynamic variable. All random numbers will be generated using this random number generator." } ; 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." } ; +{ $description "Calls the quotation with the system's random number generator in a dynamic variable. All random numbers will be generated using this random number generator." } ; { with-random with-secure-random with-system-random } related-words diff --git a/basis/random/random.factor b/basis/random/random.factor index 25c7f718d3..0c232611c8 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -14,11 +14,11 @@ SYMBOL: system-random-generator SYMBOL: secure-random-generator SYMBOL: random-generator -GENERIC# seed-random 1 ( tuple seed -- tuple' ) -GENERIC: random-32* ( tuple -- r ) -GENERIC: random-bytes* ( n tuple -- byte-array ) +GENERIC# seed-random 1 ( obj seed -- obj ) +GENERIC: random-32* ( obj -- r ) +GENERIC: random-bytes* ( n obj -- byte-array ) -M: object random-bytes* ( n tuple -- byte-array ) +M: object random-bytes* ( n obj -- byte-array ) [ integer>fixnum-strict [ ] keep ] dip [ over 4 >= ] [ [ 4 - ] dip @@ -27,7 +27,7 @@ M: object random-bytes* ( n tuple -- byte-array ) random-32* c:int swap head 0 pick copy-unsafe ] if ; -M: object random-32* ( tuple -- r ) +M: object random-32* ( obj -- r ) 4 swap random-bytes* c:uint deref ; ERROR: no-random-number-generator ; @@ -47,35 +47,48 @@ M: f random-32* ( obj -- * ) no-random-number-generator ; ] [ - [ 32 shift obj random-32* + ] [ 32 + ] [ 32 - ] tri* - ] while drop [ n * ] [ neg shift ] bi* ; inline - -: ((random-integer)) ( n obj -- n' ) - [ dup #bits ] dip (random-bits) ; inline - -GENERIC# (random-integer) 1 ( n obj -- n ) -M: fixnum (random-integer) ( n obj -- n' ) ((random-integer)) ; -M: bignum (random-integer) ( n obj -- n' ) ((random-integer)) ; - -: random-integer ( n -- n' ) - random-generator get (random-integer) ; +:: (random-bits) ( numbits obj -- r ) + numbits 32 > [ + obj random-32* numbits 32 - [ dup 32 > ] [ + [ 32 shift obj random-32* + ] [ 32 - ] bi* + ] while [ + [ shift ] keep obj random-32* swap bits + + ] unless-zero + ] [ + obj random-32* numbits bits + ] if ; inline PRIVATE> : random-bits ( numbits -- r ) - [ 2^ ] keep random-generator get (random-bits) ; + random-generator get (random-bits) ; -: random-bits* ( numbits -- n ) +: random-bits* ( numbits -- r ) 1 - [ random-bits ] keep set-bit ; + ] [ + [ 32 shift obj random-32* + ] [ 32 + ] [ 32 - ] tri* + ] while drop [ n * ] [ neg shift ] bi* ; inline + +GENERIC# (random-integer) 1 ( n obj -- r ) +M: fixnum (random-integer) ( n obj -- r ) ((random-integer)) ; +M: bignum (random-integer) ( n obj -- r ) ((random-integer)) ; + +: random-integer ( n -- r ) + random-generator get (random-integer) ; + +PRIVATE> + GENERIC: random ( obj -- elt ) -M: integer random [ f ] [ random-integer ] if-zero ; +M: integer random + [ f ] [ random-integer ] if-zero ; M: sequence random [ f ] [ @@ -122,7 +135,7 @@ ERROR: too-many-samples seq n ; [ length random-integer ] keep [ nth ] 2keep remove-nth! drop ; -: with-random ( tuple quot -- ) +: with-random ( obj quot -- ) random-generator swap with-variable ; inline : with-system-random ( quot -- ) @@ -162,12 +175,16 @@ PRIVATE> : random-integers ( length n -- sequence ) random-generator get '[ _ _ (random-integer) ] replicate ; + + : normal-random-float ( mean sigma -- n ) (cos-random-float) (log-sqrt-random-float) * * + ; @@ -186,6 +203,8 @@ PRIVATE> : pareto-random-float ( k alpha -- n ) [ random-unit ] dip recip ^ /f ; +1) ( alpha beta -- n ) ! Uses R.C.H. Cheng, "The generation of Gamma ! variables with non-integral shape parameters", @@ -237,6 +256,8 @@ PRIVATE> ] if x! ] do while x beta * ; +PRIVATE> + : gamma-random-float ( alpha beta -- n ) { { [ over 1 > ] [ (gamma-random-float>1) ] } @@ -275,6 +296,8 @@ PRIVATE> rnd (random-unit) 0.5 > [ + ] [ - ] if ] if ; + c! random-unit :> u! @@ -282,6 +305,8 @@ PRIVATE> u c > [ 1. u - u! 1. c - c! swap ] when [ - u c * sqrt * ] keep + ; +PRIVATE> + : triangular-random-float ( low high -- n ) 2dup + 2 /f (triangular-random-float) ;