以 Newick 格式懒惰地打印一棵树

Question

我希望在Newick format 中打印一棵二叉树，显示每个节点到其父节点的距离。目前我没有遇到以下代码的问题，它使用常规递归，但是树太深可能会产生堆栈溢出。

(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，但没有设法编写惰性/尾递归实现，因为我需要为每个内部节点存储它们已经被访问了多少次。

Answer 1

这是适用于您的 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 没有优化尾调用的事实，只是部分考虑了这一点。

我的解决方案的核心思想是转换为延续传递样式，因此递归调用可以移动到尾部位置（即递归调用不是返回结果，而是将其作为参数传递给延续）。

然后我手动优化了递归调用，让它们使用蹦床。我忘记考虑的是延续的调用——不是递归调用，而是在尾部位置——也需要优化，因为尾部调用可以是一个很长的闭包链，所以当函数 finally评估它们，它变成一个长长的调用链。

测试数据linear-tree 没有出现这个问题，因为第一个孩子的延续返回到蹦床来处理第二个孩子的递归调用。但是，如果 linear-tree 被更改为使用每个节点的第二个子节点而不是第一个子节点来构建线性树，这会再次导致堆栈溢出。

因此，延续的调用也需要返回蹦床。 （实际上，在 no children 基本情况下的调用不会，因为它在返回 trampoline 之前最多会发生一次，第二次递归调用也是如此。）所以这里有一个考虑到这一点的实现并且应该在所有输入上只使用常量堆栈空间：

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