Algorithm Clojure中指定大小的随机AST生成
我想生成一个随机的抽象语法树Algorithm Clojure中指定大小的随机AST生成,algorithm,random,clojure,tree,genetic-programming,Algorithm,Random,Clojure,Tree,Genetic Programming,我想生成一个随机的抽象语法树 (def terminal-set #{'x 'R}) (def function-arity {'+ 2, '- 2, '* 2, '% 2}) (def function-set (into #{} (keys function-arity))) (def terminal-vec (into [] terminal-set)) (def function-vec (into [] function-set)) ;; protected division (d
(def terminal-set #{'x 'R})
(def function-arity {'+ 2, '- 2, '* 2, '% 2})
(def function-set (into #{} (keys function-arity)))
(def terminal-vec (into [] terminal-set))
(def function-vec (into [] function-set))
;; protected division
(defn % [^Number x ^Number y]
(if (zero? y)
0
(/ x y)))
具有指定的大小
(defn treesize [tree] (count (flatten tree)))
遵循肖恩·卢克(Sean Luke)一书中的算法,2013年,《超启发式原理》,卢鲁,第二版,可在
我们随机扩展具有非叶节点的树的地平线,直到非叶节点的数量加上剩余的斑点大于或等于所需的大小。然后,我们用叶节点填充其余插槽:
比如说
(+ (* x (+ x x)) x)
是7号的
书中的算法使用指针/参考Q
,这在那里非常方便。在我的例子中,我必须使用某种递归来构造树。问题是我不能在所有使用递归的算法之间保持树的状态大小,这会导致更大的树:
(defn ptc2-tree
"Generate a random tree up to its `max-size`.
Note: `max-size` is the number of nodes, not the same as its depth."
[max-size]
(if (> 2 max-size)
(rand-nth terminal-vec)
(let [fun (rand-nth function-vec)
arity (function-arity fun)]
(cons fun (repeatedly arity #(ptc2-tree (- max-size arity 1)))))))
我还尝试使用atom
计算大小,但仍然无法获得我想要的确切树大小,它要么太小,要么太大,具体取决于实现
除此之外,我还必须以某种方式随机化插入新节点/树的位置
如何编写这个算法
编辑:最后一次触摸正确的解决方案:
(defn sequentiate [v]
(map #(if (seqable? %) (sequentiate %) %) (seq v)))
下面是本文中PTC2算法的逐字翻译。这不是很习惯的Clojure代码;您可能希望将其拆分为您认为合理的函数/更小的块
(defn ptc2 [target-size]
(if (= 1 target-size)
(rand-nth terminal-vec)
(let [f (rand-nth function-vec)
arity (function-arity f)]
;; Generate a tree like [`+ nil nil] and iterate upon it
(loop [ast (into [f] (repeat arity nil))
;; q will be something like ([1] [2]), being a list of paths to the
;; nil elements in the AST
q (for [i (range arity)] [(inc i)])
c 1]
(if (< (+ c (count q)) target-size)
;; Replace one of the nils in the tree with a new node
(let [a (rand-nth q)
f (rand-nth function-vec)
arity (function-arity f)]
(recur (assoc-in ast a (into [f] (repeat arity nil)))
(into (remove #{a} q)
(for [i (range arity)] (conj a (inc i))))
(inc c)))
;; In the end, fill all remaining slots with terminals
(reduce (fn [t path] (assoc-in t path (rand-nth terminal-vec)))
ast q))))))
我们使用向量(与列表相反)生成AST,因为它允许我们在
中使用assoc逐步构建树;如果需要,您可能想自己将其转换为嵌套列表。巧合的是,我一直在开发AST操作代码。你可以,而且
下面显示了我将如何解决这个问题。我试图让这些名字尽可能不言而喻,这样就很容易理解算法是如何进行的
基本知识:
(def op->arity {:add 2
:sub 2
:mul 2
:div 2
:pow 2})
(def op-set (set (keys op->arity)))
(defn choose-rand-op [] (rand-elem op-set))
(def arg-set #{:x :y})
(defn choose-rand-arg [] (rand-elem arg-set))
(defn num-hids [] (count (all-hids)))
助手功能:
(s/defn hid->empty-kids :- s/Int
[hid :- HID]
(let [op (hid->attr hid :op)
arity (grab op op->arity)
kid-slots-used (count (hid->kids hid))
result (- arity kid-slots-used)]
(verify (= 2 arity))
(verify (not (neg? result)))
result))
(s/defn node-has-empty-slot? :- s/Bool
[hid :- HID]
(pos? (hid->empty-kids hid)))
(s/defn total-empty-kids :- s/Int
[]
(reduce +
(mapv hid->empty-kids (all-hids))))
(s/defn add-op-node :- HID
[op :- s/Keyword]
(add-node {:tag :op :op op} )) ; add node w no kids
(s/defn add-leaf-node :- tsk/KeyMap
[parent-hid :- HID
arg :- s/Keyword]
(kids-append parent-hid [(add-leaf {:tag :arg :arg arg})]))
(s/defn need-more-op? :- s/Bool
[tgt-size :- s/Int]
(let [num-op (num-hids)
total-size-so-far (+ num-op (total-empty-kids))
result (< total-size-so-far tgt-size)]
result))
为了简单起见,我使用了三个字母的运算码而不是数学符号,但是它们可以很容易地用Clojure函数符号名称替换,以便输入到eval
谢谢!我的用例是用于遗传编程(许多AST代),这个解决方案比我勾选为正确的解决方案慢约5.8倍,我将不得不暂时离开它。PS请检查github源代码中stackoverflow的链接,你可能有错误的链接。
(s/defn hid->empty-kids :- s/Int
[hid :- HID]
(let [op (hid->attr hid :op)
arity (grab op op->arity)
kid-slots-used (count (hid->kids hid))
result (- arity kid-slots-used)]
(verify (= 2 arity))
(verify (not (neg? result)))
result))
(s/defn node-has-empty-slot? :- s/Bool
[hid :- HID]
(pos? (hid->empty-kids hid)))
(s/defn total-empty-kids :- s/Int
[]
(reduce +
(mapv hid->empty-kids (all-hids))))
(s/defn add-op-node :- HID
[op :- s/Keyword]
(add-node {:tag :op :op op} )) ; add node w no kids
(s/defn add-leaf-node :- tsk/KeyMap
[parent-hid :- HID
arg :- s/Keyword]
(kids-append parent-hid [(add-leaf {:tag :arg :arg arg})]))
(s/defn need-more-op? :- s/Bool
[tgt-size :- s/Int]
(let [num-op (num-hids)
total-size-so-far (+ num-op (total-empty-kids))
result (< total-size-so-far tgt-size)]
result))
(s/defn build-rand-ast :- tsk/Vec ; bush result
[ast-size]
(verify (<= 3 ast-size)) ; 1 op & 2 args minimum; #todo refine this
(with-debug-hid
(with-forest (new-forest)
(let [root-hid (add-op-node (choose-rand-op))] ; root of AST
; Fill in random op nodes into the tree
(while (need-more-op? ast-size)
(let [node-hid (rand-elem (all-hids))]
(when (node-has-empty-slot? node-hid)
(kids-append node-hid
[(add-op-node (choose-rand-op))]))))
; Fill in random arg nodes in empty leaf slots
(doseq [node-hid (all-hids)]
(while (node-has-empty-slot? node-hid)
(add-leaf-node node-hid (choose-rand-arg))))
(hid->bush root-hid)))))
(defn bush->form [it]
(let [head (xfirst it)
tag (grab :tag head)]
(if (= :op tag)
(list (kw->sym (grab :op head))
(bush->form (xsecond it))
(bush->form (xthird it)))
(kw->sym (grab :arg head)))))
(dotest
(let [tgt-size 13]
(dotimes [i 5]
(let [ast (build-rand-ast tgt-size)
res-str (pretty-str ast)]
(nl)
(println res-str)
(println (pretty-str (bush->form ast))) ))))
[{:tag :op, :op :mul}
[{:tag :op, :op :div}
[{:tag :op, :op :pow}
[{:tag :op, :op :sub}
[{:tag :arg, :arg :y, :value nil}]
[{:tag :arg, :arg :x, :value nil}]]
[{:tag :op, :op :div}
[{:tag :arg, :arg :y, :value nil}]
[{:tag :arg, :arg :y, :value nil}]]]
[{:tag :arg, :arg :y, :value nil}]]
[{:tag :op, :op :pow}
[{:tag :arg, :arg :x, :value nil}]
[{:tag :arg, :arg :y, :value nil}]]]
(mul (div (pow (sub y x) (div y y)) y) (pow x y))
[{:tag :op, :op :div}
[{:tag :op, :op :mul}
[{:tag :op, :op :pow}
[{:tag :arg, :arg :x, :value nil}]
[{:tag :arg, :arg :y, :value nil}]]
[{:tag :op, :op :add}
[{:tag :op, :op :div}
[{:tag :arg, :arg :x, :value nil}]
[{:tag :arg, :arg :y, :value nil}]]
[{:tag :arg, :arg :x, :value nil}]]]
[{:tag :op, :op :mul}
[{:tag :arg, :arg :x, :value nil}]
[{:tag :arg, :arg :y, :value nil}]]]
(div (mul (pow x y) (add (div x y) x)) (mul x y))