]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/combinators/random/random.factor
factor: trim using lists
[factor.git] / basis / combinators / random / random.factor
index 9e6fde9a1666c80a13761b0a21c008dd2e6f8777..ba057b055ef698eb31f0fcbfec5b7b4feb4ca101 100644 (file)
@@ -1,12 +1,13 @@
 ! Copyright (C) 2010 Jon Harper.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs combinators combinators.short-circuit
-kernel macros math math.order quotations random sequences
-summary ;
+kernel 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
 
 <PRIVATE
@@ -20,7 +21,7 @@ ERROR: bad-probabilities assoc ;
 
 M: bad-probabilities summary
     drop "The probabilities do not satisfy the rules stated in the docs." ;
-    
+
 : good-probabilities? ( assoc -- ? )
     dup last pair? [
         keys { [ sum 1 number= ] [ [ 0 1 between? ] all? ] } 1&&
@@ -34,21 +35,22 @@ M: bad-probabilities summary
         [ dup pair? [ prepare-pair ] [ with-drop ] if ] map
         cond>quot
     ] [ bad-probabilities ] if ;
-    
-MACRO: (casep) ( assoc -- ) (casep>quot) ;
+
+MACRO: (casep) ( assoc -- quot ) (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 * ;
-    
+    [ dup 0 > [ head [ 1 swap - ] [ * ] map-reduce ] [ 2drop 1 ] if ]
+    [ swap nth ] 2bi * ;
+
 : conditional-probabilities ( seq -- seq' )
-    dup length iota [ (conditional-probabilities) ] with map ;
-    
+    dup length <iota> [ (conditional-probabilities) ] with map ;
+
 : (direct>conditional) ( assoc -- assoc' )
-        [ keys conditional-probabilities ] [ values ] bi zip ;
-        
+    [ keys conditional-probabilities ] [ values ] bi zip ;
+
 : direct>conditional ( assoc -- assoc' )
     dup last pair? [ (direct>conditional) ] [
         unclip-last [ (direct>conditional) ] [ suffix ] bi*
@@ -56,14 +58,14 @@ MACRO: (casep) ( assoc -- ) (casep>quot) ;
 
 : call-random>casep ( seq -- assoc )
     [ length recip ] keep [ 2array ] with map ;
-    
+
 PRIVATE>
 
-MACRO: casep ( assoc -- ) casep>quot ;
+MACRO: casep ( assoc -- quot ) casep>quot ;
 
-MACRO: casep* ( assoc -- ) direct>conditional casep>quot ;
+MACRO: casep* ( assoc -- quot ) direct>conditional casep>quot ;
 
-MACRO: call-random ( seq -- ) call-random>casep casep>quot ;
+MACRO: call-random ( seq -- quot ) call-random>casep casep>quot ;
 
-MACRO: execute-random ( seq -- )
-    [ 1quotation ] map call-random>casep casep>quot ;
\ No newline at end of file
+MACRO: execute-random ( seq -- quot )
+    [ 1quotation ] map call-random>casep casep>quot ;