Arc Forumnew | comments | leaders | submitlogin
1 point by almkglor 5984 days ago | link | parent

If all weights are ints:

  (mac biased-choice args
    (w/uniq (choice nums sum fns rsum)
      (givens (pairs        (pair args)
               weight-exps  (map [_ 0] pairs)
               choice-exps  (map [_ 1] pairs)
               )
        `(givens (,nums   (list ,@weight-exps)
                  ,sum    (apply + ,nums)
                  ,choice (rand sum)
                  ,fns    (list ,@(map [idfn `(fn () ,_)]
                                       choice-exps))
                  ,rsum   0)
           (while (< rsum choice)
             (zap + rsum (car nums))
             (zap cdr nums)
             (zap car fns))
           ((car fns))))))
The above macro supports that the weights are expressions instead of constants

(untested)



1 point by almkglor 5983 days ago | link

ah crick: here's a working debugged version:

  (mac biased-choice args
    (w/uniq (choice nums sum fns rsum)
      (givens pairs        (pair args)
              weight-exps  (map [_ 0] pairs)
              choice-exps  (map [_ 1] pairs)
        `(withs (,nums   (list ,@weight-exps)
                 ,sum    (apply + ,nums)
                 ,choice (rand ,sum)
                 ,fns    (list t ,@(map [idfn `(fn () ,_)]
                                        choice-exps))
                 ,rsum   0)
           (while (<= ,rsum ,choice)
             (zap + ,rsum (car ,nums))
             (zap cdr ,nums)
             (zap cdr ,fns))
           ((car ,fns))))))
Also: the reason it needs ints is because of the 'rand function. We could also define a rand-float function which creates a random floating point number and use that instead:

  (def rand-float (lim) (* lim (rand)))

  (mac biased-choice args
    (w/uniq (choice nums sum fns rsum)
      (givens pairs        (pair args)
              weight-exps  (map [_ 0] pairs)
              choice-exps  (map [_ 1] pairs)
        `(withs (,nums   (list ,@weight-exps)
                 ,sum    (apply + ,nums)
                 ,choice (rand-int ,sum)
                 ,fns    (list t ,@(map [idfn `(fn () ,_)]
                                        choice-exps))
                 ,rsum   0)
           (while (<= ,rsum ,choice)
             (zap + ,rsum (car ,nums))
             (zap cdr ,nums)
             (zap cdr ,fns))
           ((car ,fns))))))
the above now works with weight expressions that return real numbers. Also as specified, only the chosen expression is executed; however, all weight expressions are executed.

-----