Clojure中对s表达式列表进行递归

Question

为了让大家了解背景，我正在学习Clojure和Lisp开发。 在学习Lisp的过程中，我目前正在通过“Little”系列努力巩固函数式编程和递归解决方案的基础。 在“The Little Schemer”中，我已经完成了许多练习，但是在将它们转换为Clojure时遇到了一些困难，尤其是在使用“recur”实现尾递归优化方面。 例如，这里是一个基于Clojure的“occurs*”函数实现（来自“The Little Schemer”），它计算出现在S表达式列表中的原子的数量:

(defn atom? [l]
  (not (list? l)))

(defn occurs [a lst]
  (cond
   (empty? lst) 0
   (atom? (first lst))
    (cond
     (= a (first lst)) (inc (occurs a (rest lst)))
     true (occurs a (rest lst)))
   true (+ (occurs a (first lst))
           (occurs a (rest lst)))))

基本上，(occurs 'abc '(abc (def abc) (abc (abc def) (def (((((abc))))))))) 的结果为5。明显的问题是这个定义消耗了栈帧，如果给出一个深度太大的S表达式列表，它将会溢出栈。

现在，我明白将递归函数重构为使用累加器参数以启用将递归调用放入尾位置（以允许TCO）的选项，但我不确定是否适用于此类情况。

以下是我使用"recur"以及累加器参数尝试进行重构的程度：

(defn recur-occurs [a lst]
  (letfn [(myoccurs [a lst count]
            (cond
             (empty? lst) 0
             (atom? (first lst))
             (cond
              (= a (first lst)) (recur a (rest lst) (inc count))
              true (recur a (rest lst) count))
             true (+ (recur a (first lst) count)
                     (recur a (rest lst) count))))]
    (myoccurs a lst 0)))

我感觉我快要成功了，但还差一点。显而易见的问题在于我的“else”语句中，列表的头部不是原子。从概念上讲，我想通过对列表中的第一个元素和剩余列表进行递归运算，然后将它们相加。我在思考如何重构代码以便将递归放到尾部位置。

除了使用“累加器”模式之外，还有哪些技术可以使递归调用处于尾部位置？或者，这个问题是否更“基本”，由于JVM缺乏尾部调用优化，Clojure并没有一个干净的解决方案呢？一般来说，Clojure程序需要递归处理S-表达式列表时应该采用什么通用模式？如果值得一提的话，我已经看到过使用多方法和lazy-seq技术（参考Halloway的《Programming Clojure》第151页）来“用惰性代替递归”的示例，但我不确定如何将该模式应用于这个例子中，因为我试图计算单个整数值，而不是构建一个列表。

非常感谢您提供的任何指导。

- Paul Evans

---

只是为了明确，我不相信《小计算机科学家》中呈现的出现*代码可以在Scheme中进行尾调用优化。 - dnolen

Answer 1

首先，我必须建议您不要太担心像堆栈溢出这样的实现问题，因为您通过The Little Schemer学习时会遇到这些问题。当您在编程过程中非常注意诸如缺乏尾递归优化之类的问题时，是有好处的，但本书的主要目的是教您递归思维。将示例转换为累加器传递样式确实是很好的练习，但本质上是放弃递归而选择迭代。

然而，我必须在此之前发出剧透警告，有一种方法可以保持相同的递归算法，而不受JVM堆栈的影响。我们可以使用续延传递样式在形式上作为额外的匿名函数参数k来创建自己的堆栈:

(defn occurs-cps [a lst k]
  (cond
   (empty? lst) (k 0) 
   (atom? (first lst))
   (cond
    (= a (first lst)) (occurs-cps a (rest lst)
                                  (fn [v] (k (inc v))))
    :else (occurs-cps a (rest lst) k))
   :else (occurs-cps a (first lst)
                     (fn [fst]
                       (occurs-cps a (rest lst)
                                   (fn [rst] (k (+ fst rst))))))))

我们不再使用非尾递归函数调用隐式地创建堆栈，而是将每个调用occurs后剩下的“待完成任务”捆绑起来，并将其作为下一个延续k传递。当我们调用它时，我们从一个代表没有剩余任务的k即恒等函数开始：

scratch.core=> (occurs-cps 'abc 
                           '(abc (def abc) (abc (abc def) (def (((((abc)))))))) 
                           (fn [v] v))
5

我不会深入讲解如何进行 CPS，因为那是 TLS 的后续章节。但是，我要指出的是，这当然还没有完全解决：

scratch.core=> (def ls (repeat 20000 'foo))          
#'scratch.core/ls
scratch.core=> (occurs-cps 'foo ls (fn [v] v))       
java.lang.StackOverflowError (NO_SOURCE_FILE:0)

CPS 让我们将所有的非平凡的、构建栈的调用移动到尾部位置，但在 Clojure 中，我们需要采取额外的步骤，用 recur 替换它们：

CPS让我们可以把所有非平凡的、堆叠式构造调用移动到尾部位置，但在Clojure中我们需要进一步使用recur进行替换。

(defn occurs-cps-recur [a lst k]
  (cond
   (empty? lst) (k 0)
   (atom? (first lst))
   (cond
    (= a (first lst)) (recur a (rest lst)
                             (fn [v] (k (inc v))))
    :else (recur a (rest lst) k))
   :else (recur a (first lst)
                (fn [fst]
                  (recur a (rest lst) ;; Problem
                         (fn [rst] (k (+ fst rst))))))))

唉，这出了问题：java.lang.IllegalArgumentException: Mismatched argument count to recur, expected: 1 args, got: 3 (core.clj:39)。最后一个 recur 实际上是指的正好在它上面的那个 fn，我们正在使用它来表示我们的连续！我们可以通过将那个 recur 更改为调用 occurs-cps-recur 来获得大多数时候良好的行为，但是嵌套路径过深的输入仍会导致堆栈溢出：

scratch.core=> (occurs-cps-recur 'foo ls (fn [v] v))
20000
scratch.core=> (def nested (reduce (fn [onion _] (list onion)) 
                                   'foo (range 20000)))
#'scratch.core/nested
scratch.core=> (occurs-cps-recur 'foo nested (fn [v] v))
Java.lang.StackOverflowError (NO_SOURCE_FILE:0)

我们可以将调用occurs-*的过程改为立即返回一个thunk，而不是期望它立即给出答案。当我们调用该thunk时，它会执行一些工作，直到进行递归调用，这将返回另一个thunk。这就是trampolined风格，"反弹"我们的thunk的函数是trampoline。每次进行递归调用时返回一个thunk，将我们的堆栈大小限制为一次调用，因此我们唯一的限制是堆:

(defn occurs-cps-tramp [a lst k]
  (fn [] 
    (cond
     (empty? lst) (k 0) 
     (atom? (first lst))
     (cond
      (= a (first lst)) (occurs-cps-tramp a (rest lst)
                                          (fn [v] (k (inc v))))
      :else (occurs-cps-tramp a (rest lst) k))
     :else (occurs-cps-tramp a (first lst)
                             (fn [fst]
                               (occurs-cps-tramp a (rest lst)
                                                 (fn [rst] (k (+ fst rst)))))))))

(declare done answer)

(defn my-trampoline [th]
  (if done
    answer
    (recur (th))))

(defn empty-k [v]
  (set! answer v)
  (set! done true))

(defn run []
  (binding [done false answer 'whocares]
    (my-trampoline (occurs-cps-tramp 'foo nested empty-k))))

;; scratch.core=> (run)                             
;; 1

请注意，Clojure内置了一个trampoline函数（对返回类型有一些限制）。使用它，我们不需要一个专门的empty-k函数：

scratch.core=> (trampoline (occurs-cps-tramp 'foo nested (fn [v] v)))
1

跳板技术确实很酷，但跳板程序的先决条件是它必须只包含尾递归调用； CPS才是真正的明星。它让您以自然递归的清晰度定义算法，并通过保持正确性的转换，在具有单个循环和堆的任何主机上高效地表达它。

- acfoltzer

---

非常感谢您提供如此详细的答案。是的，我完全同意关于不必担心JVM的细节而学习TLS中递归思维概念的评论（recursion-based thinking）。从高层次上理解您的解决方案（呃，模式）-我承认，由于我还没有深入研究CPS（以及trampoline），所以需要一段时间才能完全理解您的代码 :) 话虽如此，很高兴知道Clojure具有创造与TLS教训相符的解决方案的能力。 - Paul Evans

很高兴能够提供帮助。在很多方面上，TLS及其相关技术是为了给你提供工具，在任何环境中都能够使用这些技术所教授的经验和知识。因此，你的问题非常到位（顺便说一句，我将这个页面分享给了丹，他称之为“酷极了，非常棒”）。 - acfoltzer

Answer 2

使用固定数量的内存无法完成此操作。您可以使用堆栈或堆，这是您可以做出的决策。如果我用Clojure编写这个，我会使用map和reduce而不是手动递归：

(defn occurs [x coll]
  (if (coll? coll)
    (reduce + (map #(occurs x %) coll))
    (if (= x coll)
      1, 0)))

请注意，如果您使用tree-seq或flatten，则存在更短的解决方案，但此时大部分问题都已消失，因此没有太多可学习的内容。

编辑

这是一个版本，它不使用任何堆栈，而是让其队列变得越来越大（使用堆）。

(defn heap-occurs [item coll]
  (loop [count 0, queue coll]
    (if-let [[x & xs] (seq queue)]
      (if (coll? x)
        (recur count (concat x xs))
        (recur (+ (if (= item x) 1, 0)
                  count)
               xs))
      count)))

- amalloy

---

啊 - 这个解决方案非常合理，仍然捕捉到了《小计算机程序》的精髓（算法本质上是相同的）。那么可以说这一部分代表了消耗堆（而不是栈）的决策吗？再次感谢。 - Paul Evans

说实话，懒惰序列有时很难理解，如果你弄错了也可以原谅。这个算法实际上会消耗堆栈，因为每个“层”的 map 只有在它下面的层完成后才能完全返回。例如，(occurs 'x (nth (iterate list 'x) 1000)) 会耗尽堆栈空间。编辑： 在我的机器上是这样的。 - amalloy

@PaulEvans 我添加了一个消耗堆的版本 - 像往常一样，它更难理解，因为你基本上是在管理自己的堆栈并将其存储在堆上。 - amalloy

感谢对堆栈与堆消耗变量的澄清。这非常有帮助，肯定会有助于将“Little Schemer”解决方案转换为Clojure。 - Paul Evans