A sampling-based version of weighted-shuffle (better to use the exponential random solution)

weighted-shuffle-sampling.clj

;; This is asymptotically slower (n^2) than the exponential random sort
;; one (n log n) shown in https://gist.github.com/timmc/1211c1ac8ae96c2b42c94124005b5414
;; but it is preserved here for possible later interest

(defn weighted-random-sample
  "Given a coll of weights, pick one according to a weighted-random
selection, and return its index. Weights must be non-negative."
  [weights]
  (when (empty? weights)
    (throw (IllegalArgumentException. "Cannot sample from empty list")))
  ;; Pick a target somewhere between zero and the sum of the weights
  (let [total (apply + weights)
        target (* total (rand))]
    ;; Walk the list until the target is reached or passed
    (loop [index 0
           tail weights
           accumulated 0]
      (if (<= (count tail) 1)
        ;; If only one element left, return its index.
        index
        (let [next-accum (+ accumulated (first tail))]
          (if (< target next-accum)
            ;; If we would pass the target by accumulating the current
            ;; weight, then this is the right index
            index
            ;; Otherwise, move along
            (recur (inc index)
                   (rest tail)
                   next-accum)))))))

(defn weighted-shuffle-annotated
  "Perform a weighted shuffle on a collection of element/weight pairs."
  [weighted-els]
  (lazy-seq
   (if (empty? weighted-els)
     []
     (let [picked-index (weighted-random-sample (map second weighted-els))
           picked-pair (nth weighted-els picked-index)]
       (cons picked-pair (weighted-shuffle-annotated
                          (concat (take picked-index weighted-els)
                                  (drop (inc picked-index) weighted-els))))))))

(defn weighted-shuffle
  "Perform a weighted shuffle on a collection. weight-fn is called at
most once for every element in the collection."
  [weight-fn coll]
  (->> coll
       (shuffle) ;; tie-break any zero weights
       (map (juxt identity weight-fn))
       (weighted-shuffle-annotated)
       (map first)))