bar.lisp

(defun probability-choice (lst)
  "Expect LST to be ((prob item) (prob item) ...). It doesn't have to be
sorted but all PROB values must sum to 1. Return a random item based on these
probabilities."
  (let ((tol 1d-10)
        (prob-sum (reduce #'+ lst :key #'car)))
    (assert (<= (- 1d0 (abs prob-sum)) tol)))

  (format t "Probabilities are good.~%")

  (let ((prefix-sum-lst
          (loop :for (x . item) in lst
                :sum x :into y :collect (cons y item)))
        (choice (random 1d0)))

    (format t "Prefix-sum-lst is: ~A~%" prefix-sum-lst)

    ;; Now, walk the pairs until I find one where the value I picked is smaller
    ;; or equal to the prefix-sum probability
    (loop :for (prob item) :in prefix-sum-lst
          :do (when (<= choice prob)
                (format t "Choice was: ~A, selected item was: ~A~%"
                        choice (cons prob item))
                (return item)))))

;; CL-USER> (probability-choice '((.1 foo) (.4 bar) (.3 feh) (.2 qux)))
;; Probabilities are good.
;; Prefix-sum-lst is: ((0.1 FOO) (0.5 BAR) (0.8 FEH) (1.0 QUX))
;; Choice was: 0.6781761996771678d0, selected item was: (0.8 FEH)
;; FEH