/unmaintained/random-weighted/random-weighted.factor

http://github.com/abeaumont/factor · Factor · 20 lines · 13 code · 7 blank · 0 comment · 1 complexity · a12a363c67a99b74e2b41d7de5e4accb MD5 · raw file

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