From 601ae65af6419759a4dd47be6d4fb2c8efe084f4 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 29 Sep 2007 13:28:53 -0500 Subject: [PATCH] random-weighted: add call-random-weighted macro --- extra/random-weighted/random-weighted.factor | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/extra/random-weighted/random-weighted.factor b/extra/random-weighted/random-weighted.factor index 0ec366beb0..cc050eb4df 100644 --- a/extra/random-weighted/random-weighted.factor +++ b/extra/random-weighted/random-weighted.factor @@ -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 -: probabilities ( weights -- probabilities ) -dup sum [ / ] curry map ; +: probabilities ( weights -- probabilities ) dup sum [ / ] curry map ; : layers ( probabilities -- layers ) 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 ; : random-weighted* ( seq -- elt ) -dup [ second ] map swap [ first ] map random-weighted swap nth ; \ No newline at end of file +dup [ second ] map swap [ first ] map random-weighted swap nth ; + +MACRO: call-random-weighted ( exp -- ) + [ keys ] [ values >alist ] bi swap + [ , random-weighted , case ] bake ;