2013-10-17 36 views
2

我希望在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-seqclojure.walk发现的问题,是我要拜访的内部节点不止一次,以夹着逗号和关闭支架。我用clojure.zip,但没有设法写一个懒/尾递归实现,因为我需要为每个内部节点存储它们已经访问了多少次。

回答

4

以下是适用于您的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)))))) 
+0

虽然我不能够维护它,但令人印象深刻!要在面向对象的范例中编写更好的代码,你必须学习模式;要在功能范例中更好地编写代码,您必须学习计算机科学。 –

+0

@BrunoKim:如果可以的话,看一看The Little Schemer一书。第8章(Lambda the Ultimate)的结尾处理了延续传球的风格。为了给出一个简短的解释,它基本上用包装其他闭包的闭包代替了调用堆栈。而蹦床只是一个巧妙的小诀窍,可以在“recur”支持的特殊情况之外进行尾递归:只要返回值是一个函数,蹦床就会调用它。 –