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

  (mac bias args
    (withs (ps (pair args)
            bs (map car ps))
     `(let r (rand (apply + ',bs))
        (if ,@(mappend list
                (rev (accum a
                       (for i 1 (len bs)
                         (a (list '< 'r
                                  (apply + (cut bs 0 i)))))))
                (map cadr ps))))))


1 point by skenney26 5983 days ago | link

  (mac bias args
    (withs (ps (pair args)
            bs (map car ps))
     `(let r (rand (apply + ',bs))
        (if ,@(mappend list
                (map [list '< 'r (apply + (cut bs 0 _))]
                     (range 1 (len bs)))
                (map cadr ps))))))

-----

1 point by skenney26 5983 days ago | link

  (mac bias args
    (withs (ps (pair args)
            bs (map car ps))
     `(let r (rand (apply + ',bs))
        (if ,@(let i 0
                (mappend
                  [list (list '< 'r (apply + (cut bs 0 (++ i)))) _]
                  (map cadr ps)))))))
This one is very similar to the definition of rand-choice. (Why does the mappend expression work? Aren't the values of the biases unavailable during macro-expansion?)

-----

1 point by almkglor 5983 days ago | link

> (Why does the mappend expression work? Aren't the values of the biases unavailable during macro-expansion?)

They are if the biases are constant numbers.

See my solution above instead for a way of making it work with non-constant biases

-----

1 point by skenney26 5982 days ago | link

This version still needs some massaging but it works with non-constant biases:

  (mac bias args
    (let bs (map car (pair args))
     `(let r (rand (+ ,@bs))
        (if ,@(let i 0
                (rev (accum a
                       (each c (map cadr (pair args))
                         (a `(< r (+ ,@(cut bs 0 (++ i)))))
                         (a c)))))))))


  arc> (with (a 1 b 2 c 3) (bias a 'red b 'white c 'blue))
  white

-----

3 points by rkts 5982 days ago | link

Your macro has problems with variable capture and multiple evaluation (see chapters 9-10 of On Lisp). Here's a version that should work properly:

  (mac bias args
    (w/uniq r
      (withs (ws (map car  (pair args))
              xs (map cadr (pair args))
              us (map [uniq] ws))
        `(with ,(mappend list us ws)
           (let ,r (rand (+ ,@us))
             (if ,@(mappend
                     (fn (u x) `((< (-- ,r ,u) 0) ,x))
                     us xs)))))))
IMO, though, the use of a macro here is a premature optimization. I think you should try to get a function working first, and then wrap a macro around it if you know that's what you need. See my comment http://arclanguage.org/item?id=7760 for an example of such a wrapper macro (in CL, but the Arc is similar).

-----

1 point by skenney26 5980 days ago | link

  (mac bias args
    (w/uniq (bs r)
     `(withs (,bs (list ,@(map car (pair args)))
              ,r  (rand (apply + ,bs)))
        (if ,@(mappend
                (fn (c) `((< (-- ,r (pop ,bs)) 0) ,c))
                (map cadr (pair args)))))))

-----

1 point by skenney26 5981 days ago | link

Interesting solution. I like the clever use of --

-----

1 point by almkglor 5982 days ago | link

I still suggest you take a look at how I do it http://arclanguage.com/item?id=7765 , which (1) avoids multiple evaluation, and (2) avoids variable capture.

(1) is the hard part here, which is why I had to use a list.

-----