Ленивая печать дерева в формате Newick

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

(defn tree->newick
  [tree]
  (let [{:keys [id children to-parent]} tree
        dist (double to-parent)] ; to-parent may be a rational
    (if children
      (str "(" (tree->newick (first children)) 
           "," (tree->newick (second children)) 
           "):" dist)
      (str (name id) ":" dist))))

(def example {:id nil :to-parent 0.0 
              :children [{:id nil :to-parent 0.5 
                          :children [{:id "A" :to-parent 0.3 :children nil}
                                     {:id "B" :to-parent 0.2 :children nil}]}
                         {:id "C" :to-parent 0.8 :children nil}]})

(tree->newick example)
;=> "((A:0.3,B:0.2):0.5,C:0.8):0.0"

(def linear-tree (->> {:id "bottom" :to-parent 0.1 :children nil}
                   (iterate #(hash-map :id nil :to-parent 0.1 
                                       :children [% {:id "side" :to-parent 0.1 :children nil}]))
                   (take 10000)
                   last))

(tree->newick linear-tree)
;=> StackOverflowError

Проблема, которую я обнаружил с текущими утилитами, такими как tree-seq и clojure.walk, заключается в том, что мне приходится посещать внутренний узел более одного раза, чтобы вставить запятую и закрыть скобку. Я использовал clojure.zip, но не смог написать ленивую/хвост-рекурсивную реализацию, так как мне нужно было бы хранить для каждого внутреннего узла, сколько раз они уже были посещены.


clojure lazy-sequences tree-traversal zipper
person Bruno Kim    schedule 17.10.2013    source источник

Ответы (1)


arrow_upward
4
arrow_downward

Вот версия, которая работает на вашем примере linear-tree. Это прямое преобразование вашей реализации с двумя изменениями: он использует стиль передачи продолжения и трамплин.

(defn tree->newick
  ([tree]
     (trampoline tree->newick tree identity))
  ([tree cont]
     (let [{:keys [id children to-parent]} tree
           dist (double to-parent)]     ; to-parent may be a rational
       (if children
         (fn []
           (tree->newick
            (first children)
            (fn [s1] (fn []
                       (tree->newick
                        (second children)
                        (fn [s2] (cont (str "(" s1 "," s2 "):" dist))))))))
         (cont (str (name id) ":" dist))))))

Изменить: добавлено сопоставление с образцом, позволяющее упростить вызов функции.

Редактировать 2: я заметил, что допустил ошибку. Проблема в том, что я частично учел тот факт, что Clojure не оптимизирует хвостовые вызовы.

Основной идеей моего решения является преобразование в стиль передачи продолжения, чтобы рекурсивные вызовы можно было перемещать в хвостовую позицию (т. е. вместо того, чтобы возвращать свой результат, рекурсивные вызовы передают его продолжению в качестве аргумента).

Затем я вручную оптимизировал рекурсивные вызовы, заставив их использовать батут. Что я забыл учесть, так это то, что вызовы продолжений — которые не являются рекурсивными вызовами, но также находятся в хвостовой позиции — также должны быть оптимизированы, потому что хвостовые вызовы могут быть очень длинной цепочкой замыканий, так что, когда функция наконец оценивает их, это становится длинной цепочкой вызовов.

Эта проблема не материализовалась с тестовыми данными linear-tree, поскольку продолжение для первого дочернего элемента возвращается к батуту для обработки рекурсивного вызова для второго дочернего элемента. Но если linear-tree изменить так, чтобы он использовал второй дочерний элемент каждого узла для построения линейного дерева вместо первого дочернего элемента, это снова вызовет переполнение стека.

Так что вызовы продолжений тоже нужно возвращать на батут. (На самом деле вызов в базовом случае без дочерних элементов не работает, потому что это произойдет не более одного раза, прежде чем вернуться к батуту, и то же самое будет верно для второго рекурсивного вызова.) Итак, вот реализация, которая учитывает это. и должен использовать только постоянное пространство стека на всех входах:

(defn tree->newick
  ([tree]
     (trampoline tree->newick tree identity))
  ([tree cont]
     (let [{:keys [id children to-parent]} tree
           dist (double to-parent)]     ; to-parent may be a rational
       (if children
         (fn [] (tree->newick
                 (first children)
                 (fn [s1] (tree->newick
                           (second children)
                           (fn [s2] #(cont (str "(" s1 "," s2 "):" dist)))))))
         (cont (str (name id) ":" dist))))))
person Rörd    schedule 17.10.2013
comment
Это впечатляет, хотя я бы не смог (пока) поддерживать его! Чтобы лучше кодировать в парадигме OO, вы должны изучить шаблоны; чтобы лучше программировать в функциональных парадигмах, вы должны изучать информатику. - person Bruno Kim; 18.10.2013
comment
@BrunoKim: Взгляните на книгу «Маленький интриган», если сможете. Конец главы 8 (Lambda the Ultimate) посвящен стилю прохождения продолжения. Чтобы дать очень краткое объяснение, он в основном заменяет стек вызовов замыканиями, обертывающими другие замыкания. А трамплин — это просто изящная маленькая хитрость, позволяющая заставить хвостовую рекурсию работать за пределами особых случаев, поддерживаемых recur: всякий раз, когда возвращаемое значение является функцией, трамплин будет вызывать ее. - person Rörd; 18.10.2013