Случайная генерация AST с указанным размером в Clojure - PullRequest
0 голосов
/ 01 сентября 2018

Я хотел бы создать случайное абстрактное синтаксическое дерево

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

по алгоритму из книги Шона Люка, 2013, Основы метаэвристики, Лулу, второе издание, доступно по адресу https://cs.gmu.edu/~sean/book/metaheuristics/

Мы случайным образом расширяем горизонт дерева с нелистыми узлами до тех пор, пока количество нелистых узлов плюс оставшиеся пятна не станет больше или равно желаемому размеру. Затем мы заполняем оставшиеся слоты листовыми узлами:

ptc2 algorithm

Например

(+ (* x (+ x x)) x)

имеет размер 7.

Алгоритм в книге использует указатели / ссылки Q, что очень удобно там. В моем случае я должен использовать какую-то рекурсию для построения дерева. Проблема в том, что я не могу сохранить состояние size дерева между всеми алгоритмами, использующими рекурсию, что приводит к большим деревьям:

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

Ответы [ 2 ]

0 голосов
/ 02 сентября 2018

Как совпадение, я работал над кодом манипуляции AST в в библиотеке Тупело Форест . Вы можете посмотреть пример кода здесь и видео с Clojure / Conj 2017 здесь .

Ниже показано, как бы я решил эту проблему. Я попытался сделать имена как можно более очевидными, чтобы было легко понять, как работает алгоритм.

Основа:

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

Основной алгоритм:

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

Он печатает результаты как в виде иероглифа "кустарник", так и в виде шрифтов. Вот 2 типичных результата:

[{: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))

Для простоты я использовал трехбуквенные операционные коды вместо математических символов, но их можно было легко заменить именами символов функции Clojure для ввода в eval.

0 голосов
/ 01 сентября 2018

Ниже приведен более или менее дословный перевод алгоритма 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))))))

Вы можете использовать конструкцию Clojure loop (или reduce, чтобы сохранить состояние вашей итерации - в этом алгоритме это состояние включает):

  • ast, который представляет собой вложенный вектор, представляющий формулу, которая строится, где еще не завершенные узлы помечаются как nil;
  • q, что соответствует Q в псевдокоде и представляет собой список путей к незавершенным узлам в ast,
  • и c, то есть количество неконечных узлов в дереве.

В результате вы получите что-то вроде:

(ptc2 10) ;; => [* [- R [% R [% x x]]] [- x R]]

Мы делаем AST, используя векторы (в отличие от списков), так как это позволяет нам использовать assoc-in для постепенного построения дерева; Вы можете преобразовать его во вложенные списки самостоятельно, если вам нужно.

...