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

时间:2013-01-22 17:03:49

标签: clojure idiomatic

在涉及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))

4 个答案:

答案 0 :(得分:7)

我建议在学习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}

答案 1 :(得分:6)

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)))))))

答案 2 :(得分:4)

通常有助于将问题分解为可以独立解决的层。 Augment在分配范围方面做得很好,但是在随机选择一个时,使用正常的序列函数会更难以消耗。如果你改变扩充的目标,让它产生一个正常的seq,那么扩充问题就会更加干净地与随机选择一个问题分开。如果权重是整数,您可以构建一个包含每个项目的权重编号的列表,然后随机选择一个:

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])) 

答案 3 :(得分:0)

开源bigml采样库是另一种选择。我已经成功地使用了它。它记录得更好,并且有一个很好的API。