Arc Forumnew | comments | leaders | submitlogin
1 point by fallintothis 5980 days ago | link | parent

Besides the other solutions noted that are more "classic" answers to the problem, I think it's important to ask: why does this have to be a macro? Using eval within a macro, in my experience, is often a sign that you don't need it; you want a function instead. I can't see any signs of the need here either. To say nothing of the soundness of the original solution's method, I believe that this would work:

  (def unzip (xs)
    (let ps (pair xs)
      (list (map car ps) (map cadr ps))))

  (def sum (xs)
    (apply + xs))

  (def biased-choice args
    (withs ((bs cs) (unzip args)
             r (rand (sum bs)))
      ((afn (bs cs i)
         (if (< r (sum (cut bs 0 i)))
             (cs (-- i))
             (self bs cs (++ i))))
       bs cs 1)))
If I'm mistaken for some reason, please beat some sense into me.


1 point by skenney26 5980 days ago | link

The problem with using a function is all the arguments are evaluated.

  arc> (biased-choice 3 'black 3 'white 1 (pr 'blue))
  blueblack

-----

1 point by almkglor 5980 days ago | link

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 5980 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.

-----

1 point by fallintothis 5980 days ago | link

Ah, I misread that you wanted something akin to random-elt rather than rand-choice -- i.e., you'd want to use this as a control structure, in which case a macro indeed is what you'd need. My bad. That's what I get for commenting on an empty stomach (well, empty brain is more like it, but excuses are entertaining).

-----