diff --git a/basis/combinators/random/random.factor b/basis/combinators/random/random.factor index 9e6fde9a166..167fc844f33 100644 --- a/basis/combinators/random/random.factor +++ b/basis/combinators/random/random.factor @@ -5,7 +5,7 @@ kernel macros math math.order quotations random sequences summary ; IN: combinators.random -: ifp ( p true false -- ) [ 0 1 uniform-random-float > ] 2dip if ; inline +: ifp ( p true false -- ) [ random-unit > ] 2dip if ; inline : whenp ( p true -- ) [ ] ifp ; inline : unlessp ( p false -- ) [ [ ] ] dip ifp ; inline @@ -38,7 +38,7 @@ M: bad-probabilities summary MACRO: (casep) ( assoc -- ) (casep>quot) ; : casep>quot ( assoc -- quot ) - (casep>quot) [ 0 1 uniform-random-float ] prepend ; + (casep>quot) [ random-unit ] prepend ; : (conditional-probabilities) ( seq i -- p ) [ dup 0 > [ head [ 1 swap - ] [ * ] map-reduce ] [ 2drop 1 ] if ] [ swap nth ] 2bi * ; @@ -66,4 +66,4 @@ MACRO: casep* ( assoc -- ) direct>conditional casep>quot ; MACRO: call-random ( seq -- ) call-random>casep casep>quot ; MACRO: execute-random ( seq -- ) - [ 1quotation ] map call-random>casep casep>quot ; \ No newline at end of file + [ 1quotation ] map call-random>casep casep>quot ; diff --git a/basis/random/random.factor b/basis/random/random.factor index a05cd1185cf..906170ecfed 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -102,11 +102,14 @@ ERROR: too-many-samples seq n ; [ over - 2.0 -64 ^ * ] dip * + ; inline +: random-unit ( -- n ) + 0.0 1.0 uniform-random-float ; inline + : (cos-random-float) ( -- n ) - 0. 2. pi * uniform-random-float cos ; + 0. 2pi uniform-random-float cos ; : (log-sqrt-random-float) ( -- n ) - 0. 1. uniform-random-float log -2. * sqrt ; + random-unit log -2. * sqrt ; : normal-random-float ( mean sigma -- n ) (cos-random-float) (log-sqrt-random-float) * * + ; @@ -115,13 +118,13 @@ ERROR: too-many-samples seq n ; normal-random-float exp ; : exponential-random-float ( lambda -- n ) - 0. 1. uniform-random-float log neg swap / ; + random-unit log neg swap / ; : weibull-random-float ( lambda k -- n ) - [ 0. 1. uniform-random-float log neg ] dip 1. swap / ^ * ; + [ random-unit log neg ] dip 1. swap / ^ * ; : pareto-random-float ( alpha -- n ) - [ 0. 1. uniform-random-float ] dip [ 1. swap / ] bi@ ^ ; + [ random-unit ] dip [ 1. swap / ] bi@ ^ ; : beta-random-float ( alpha beta -- n ) [ 1. normal-random-float ] dip over zero? diff --git a/extra/chipmunk/demo/demo.factor b/extra/chipmunk/demo/demo.factor index 1f30d93bdcb..1f9b709c82a 100644 --- a/extra/chipmunk/demo/demo.factor +++ b/extra/chipmunk/demo/demo.factor @@ -110,8 +110,8 @@ M:: chipmunk-world begin-game-world ( world -- ) image-height iota [| y | image-width iota [| x | x y get-pixel [ - x image-width 2 / - 0.05 0.0 1.0 uniform-random-float * + 2 * - image-height 2 / y - 0.05 0.0 1.0 uniform-random-float * + 2 * + x image-width 2 / - 0.05 random-unit * + 2 * + image-height 2 / y - 0.05 random-unit * + 2 * make-ball :> shape space shape shape>> body>> cpSpaceAddBody drop space shape cpSpaceAddShape drop