extra/random-weighted/random-weighted.factor

   1
   2 USING: kernel namespaces arrays quotations sequences assocs combinators
   3        mirrors math math.vectors random macros fry ;
   4
   5 IN: random-weighted
   6
   7 : probabilities ( weights -- probabilities ) dup sum v/n ;
   8
   9 : layers ( probabilities -- layers )
  10 dup length 1+ [ head ] with map rest [ sum ] map ;
  11
  12 : random-weighted ( weights -- elt )
  13 probabilities layers [ 1000 * ] map 1000 random [ > ] curry find drop ;
  14
  15 : random-weighted* ( seq -- elt )
  16 dup [ second ] map swap [ first ] map random-weighted swap nth ;
  17
  18 MACRO: call-random-weighted ( exp -- )
  19   [ keys ] [ values <enum> >alist ] bi
  20   '[ _ random-weighted _ case ] ;