chance macro

chance.clj

(defmacro chance [& body]
  (let [r (gensym "chance")
        pairs (sort-by first (partition 2 body))
        odds (map first pairs)
        exprs (map last pairs)
        sum (apply + odds)
        fracs (map #(float (/ % sum)) odds)
        frac-pairs (partition 2 (interleave fracs exprs))]
    `(let [~r (rand)]
       (cond
         ~@(apply concat
                  (reduce
                    (fn [acc [odds expr]]
                      (let [odd-sum (if (seq acc)
                                      (-> acc last first last)
                                      0)]
                        (conj acc [`(< ~r ~(+ odd-sum odds))
                                   expr])))
                    []
                    (drop-last frac-pairs)))
         :else
         ~(-> frac-pairs last last)))))

usage.clj

(chance
  1 "empty"
  1 "pineapple")

; (let*
;  [chance3864 (clojure.core/rand)]
;  (clojure.core/cond
;   (clojure.core/< chance3864 0.5)
;   "pineapple"
;   :else
;   "empty"))

(chance
  1 "empty"
  2 "pineapple")

; (let*
;  [chance3894 (clojure.core/rand)]
;  (clojure.core/cond
;   (clojure.core/< chance3894 0.333333343267441)
;   "empty"
;   :else
;   "pineapple"))

(chance
  10 "empty"
  30 "apple"
  52 "pineapple"
  90 "for sure"
  5 "just maybe")

; (let*
;  [chance3909 (clojure.core/rand)]
;  (clojure.core/cond
;   (clojure.core/< chance3909 0.0267379675060511)
;   "just maybe"
;   (clojure.core/< chance3909 0.0802139025181532)
;   "empty"
;   (clojure.core/< chance3909 0.24064171127975)
;   "apple"
;   (clojure.core/< chance3909 0.518716571852565)
;   "pineapple"
;   :else
;   "for sure"))

neato

reductions is sometimes handy for avoiding unpacking the end of accumulators (which isn't supported by destructuring):

(defmacro chance [& body]
  (let [parts (partition 2 body)
        total (apply + (map first parts))
        rsym (gensym "random_")
        clauses (->> (sort-by first > parts)
                  (reductions
                    (fn [[odds-1 _]
                        [odds-2 expr-2]]
                      [(+ odds-1 (/ odds-2 total)) expr-2])
                    [0 nil])
                  rest
                  (mapcat
                    (fn [[odds expr]]
                      [`(< ~rsym ~odds) expr])))]
    `(let [~rsym (rand)]
       (cond ~@clauses))))

though I suppose that falls into the hmmmmmWELL have you considered blargleblargleblargle class of feedback comments

hmmmmmWELL actually tims have you considered

(defmacro chance [& body]
  (let [parts (partition 2 body)
        total (apply + (map first parts))
        rsym (gensym "random_")
        clauses (->> parts
                  (sort-by first (comparator >))
                  (reductions
                    (fn [[odds-1 _]
                        [odds-2 expr-2]]
                      [(+ odds-1 (/ odds-2 total)) expr-2])
                    [0 nil])
                  rest
                  (mapcat
                    (fn [[odds expr]]
                      [(or (= 1 odds) `(< ~rsym ~odds))
                       expr])))]
    `(let [~rsym (rand)]
       (cond ~@clauses))))