]> gitweb.factorcode.org Git - factor.git/commitdiff
random: Add random-unit word. 1 random-unit - is the same distribution, as Joe pointe...
authorDoug Coleman <doug.coleman@gmail.com>
Sat, 31 Mar 2012 00:56:00 +0000 (17:56 -0700)
committerDoug Coleman <doug.coleman@gmail.com>
Sat, 31 Mar 2012 01:04:45 +0000 (18:04 -0700)
basis/combinators/random/random.factor
basis/random/random.factor
extra/chipmunk/demo/demo.factor

index 9e6fde9a1666c80a13761b0a21c008dd2e6f8777..167fc844f33082bd82e0e9f9f3a0dd8760848477 100644 (file)
@@ -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 ;
index a05cd1185cf3b5ee1920b55bb13a8d363b266540..906170ecfed5b0082fb4a3945d99d1e35c4378fa 100644 (file)
@@ -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?
index 1f30d93bdcbe717b4e4a49da4c1b93ab4483f7b3..1f9b709c82a9eab6cb118548906147df0cef7219 100644 (file)
@@ -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