steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

random-weighted: add call-random-weighted macro

release
Eduardo Cavazos 2007-09-29 13:28:53 -05:00
parent ce4486d00f
commit 601ae65af6
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
extra/random-weighted/random-weighted.factor
View File

@ -1,10 +1,10 @@
USING: kernel quotations sequences math math.vectors random ; USING: kernel namespaces arrays quotations sequences assocs combinators
mirrors math math.vectors random combinators.lib macros bake ;
IN: random-weighted IN: random-weighted
: probabilities ( weights -- probabilities ) : probabilities ( weights -- probabilities ) dup sum [ / ] curry map ;
dup sum [ / ] curry map ;
: layers ( probabilities -- layers ) : layers ( probabilities -- layers )
dup length 1+ [ head ] curry* map 1 tail [ sum ] map ; dup length 1+ [ head ] curry* map 1 tail [ sum ] map ;
@ -13,4 +13,8 @@ dup length 1+ [ head ] curry* map 1 tail [ sum ] map ;
probabilities layers [ 1000 * ] map 1000 random [ > ] curry find drop ; probabilities layers [ 1000 * ] map 1000 random [ > ] curry find drop ;
: random-weighted* ( seq -- elt ) : random-weighted* ( seq -- elt )
dup [ second ] map swap [ first ] map random-weighted swap nth ; dup [ second ] map swap [ first ] map random-weighted swap nth ;
MACRO: call-random-weighted ( exp -- )
[ keys ] [ values <enum> >alist ] bi swap
[ , random-weighted , case ] bake ;