用于在随机加权选择之间进行选择的惯用 Clojure

Posted 2023-02-22

【中文标题】用于在随机加权选择之间进行选择的惯用 Clojure

【英文标题】：Idiomatic Clojure for picking between random weighted choices

【发布时间】：2013-01-06 00:07:44

【问题描述】：

在涉足 Clojure 时，我完成了一个小示例程序，用于从选项列表中选择一个随机选项。

基本思想是迭代选择（分配权重）并将它们的权重转换为一个范围，然后在总范围内选择一个随机数来选择一个。它可能不是最优雅的设计，但我们认为它是理所当然的。

与我下面的示例相比，我的做法有何不同？

我对整体程序结构建议、名称间距等不感兴趣，主要是对您对每个功能的处理方式。

我对经验丰富的 Clojurer 如何处理“增强”函数特别感兴趣，在该函数中，我必须使用外部“cur”变量来引用范围的前一个端点。

  (def colors
      (hash-map 
            :white 1,
            :red 10,
            :blue 20,
            :green 1,
            :yellow 1
       )
     )

    (def color-list (vec colors))

    (def cur 0)

    (defn augment [x] 
      (def name (nth x 0))
      (def val (nth x 1))
      (def newval (+ cur val))
      (def left cur)
      (def right newval)
      (def cur (+ cur val))
      [name left right]
    )

    (def color-list-augmented (map augment color-list))

    (defn within-bounds [bound]
      (def min-bound (nth bound 1))
      (def max-bound (nth bound 2))
      (and (> choice min-bound) (< choice max-bound))
    )

    (def choice (rand-nth (range cur)))

    (def answer 
      (first (filter within-bounds color-list-augmented))
    )

    (println "Random choice:" (nth answer 0))

【问题讨论】：

永远不要在函数中使用 (def ...)，即使你确实想修改全局状态。

谢谢，我只是在学习语法。我想本地函数范围还有其他东西吗？ “让”也许？

【参考方案1】：

Rich Hickey 来自ants.clj 的有点过时（2008 年）的解决方案：

(defn wrand 
  "given a vector of slice sizes, returns the index of a slice given a
  random spin of a roulette wheel with compartments proportional to
  slices."
  [slices]
  (let [total (reduce + slices)
        r (rand total)]
    (loop [i 0 sum 0]
      (if (< r (+ (slices i) sum))
        i
        (recur (inc i) (+ (slices i) sum))))))

Stuart Halloway 来自data.generators 的最新（2012 年）解决方案：

(defn weighted
  "Given a map of generators and weights, return a value from one of
  the generators, selecting generator based on weights."
  [m]
  (let [weights   (reductions + (vals m))
        total   (last weights)
        choices (map vector (keys m) weights)]
    (let [choice (uniform 0 total)]
      (loop [[[c w] & more] choices]
        (when w
          (if (< choice w)
            (call-through c)
            (recur more)))))))

【讨论】：

braveclojure.com 中讨论了一个类似的算法（关于打击霍比特人的章节），几乎遵循 Rich Hickey 上面的解决方案。不过，在我读到 Rich 对轮盘赌隐喻的评论之前，我无法理解它——感谢分享！

【参考方案2】：

我建议在学习 Clojure 的同时在 http://www.4clojure.com/ 做一些问题。您可以“关注”排名靠前的用户，看看他们如何解决问题。

这里有一个解决方案。它再次不是最有效的，因为我的目标是保持简单，而不是使用您稍后将学习的更高级的想法和结构。

user=> (def colors :white 1  :red 10  :blue 20  :green 1  :yellow 1)
#'user/colors
user=> (keys colors)
(:white :red :blue :green :yellow)   
user=> (vals colors)
(1 10 20 1 1)

为了将权重转化为区间，我们只需做一个累积和：

user=> (reductions #(+ % %2) (vals colors))
(1 11 31 32 33)

寻找随机区间：

user=> (rand-int (last *1))
13
user=> (count (take-while #(<= % *1 ) *2 ))
2

注意 REPL 中的 *1 指的是最近打印的值，*2 指的是下一个最近的值，等等。所以我们要求一个介于 0（包括）和 33（不包括）之间的随机整数。这 33 个可能的选择对应于权重的总和。接下来，我们计算了找到该数字需要经过的间隔数。这里的随机数是 13。

(1 11 31 32 33) 
     ^ 13 belongs here, 2 numbers in

我们找到我们的随机数 2。请注意，为了降落在这里，我们必须至少有 11 但少于 31，所以有 20 种可能性，这正是……的权重。

user=> (nth (keys colors) *1)
:blue

所以，把这一切放在一个函数中：

(defn weighted-rand-choice [m]
    (let [w (reductions #(+ % %2) (vals m))
          r (rand-int (last w))]
         (nth (keys m) (count (take-while #( <= % r ) w)))))

让我们测试一下：

user=> (->> #(weighted-rand-choice colors) repeatedly (take 10000) frequencies)
:red 3008, :blue 6131, :white 280, :yellow 282, :green 299

【参考方案3】：

通常有助于将问题分解为可以独立解决的层。增强在分配范围方面做得很好，尽管在随机选择一个时，结果很难用正常的序列函数来消费。如果你改变增广的目标，让它产生一个正常的序列，那么增广问题与随机选择一个更清晰地分开。如果权重是整数，您可以构建一个包含每个项目的权重编号的列表，然后随机选择一个：

user> (map (fn [[item weight]] (repeat weight item)) colors)
((:white) 
 (:red :red :red :red :red :red :red :red :red :red) 
 (:blue :blue :blue :blue :blue :blue :blue :blue :blue :blue
  :blue :blue :blue :blue :blue :blue :blue :blue :blue :blue) 
 (:green) (:yellow)) 

然后将其扁平化为一个列表：

user> (flatten (map (fn [[item weight]] 
                       (repeat weight item)) 
                 colors))
(:white :red :red :red :red :red :red :red :red :red :red 
 :blue :blue :blue :blue :blue :blue :blue :blue :blue :blue 
 :blue :blue :blue :blue :blue :blue :blue :blue :blue :blue 
 :green :yellow)

然后用rand-nth选择一个：

user> (rand-nth (flatten (map (fn [[item weight]] (repeat weight item)) colors)))
:blue

---

ps：地图文字让事情看起来更好：the reader page 很好地描述了这些

(def colors :white 1,
             :red 10,
             :blue 20,
             :green 1,
             :yellow 1)

使用 let 给函数中的事物命名：

(defn augment [x]
  (let [name (nth x 0)
        val (nth x 1)
        newval (+ cur val)
        left cur
        right newval
        cur (+ cur val)]
    [name left right])) 

【讨论】：

(->> :a 10 :b 1 (map #(->> % reverse (apply repeat))) flatten rand-nth) 很优雅，但速度很慢（呃），重量很荒谬，比如:a 10000000 :b 100000

【参考方案4】：

开源bigml 采样库是另一种选择。我使用它取得了一些成功。它有更好的文档记录，并且有一个很好的 API。