random: Add random-unit word. 1 random-unit - is the same distributio…

…n, as Joe pointed out, so remove that. Use random-unit in librarie.
slavapestov · Mar 31, 2012 · 6686cae · 6686cae
1 parent b23f3f8
commit 6686cae
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 10 deletions.
diff --git 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 ;
+    [ 1quotation ] map call-random>casep casep>quot ;
diff --git 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
@@ -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