Рекурсия по списку s-выражений в Clojure

Во-первых, я должен посоветовать вам не сильно беспокоиться о проблемах реализации, таких как переполнение стека, когда вы пробираетесь через 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:

(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-* и ожидать, что он вернет ответ, мы можем заставить его немедленно вернуть преобразователь. Когда мы вызываем этот преобразователь, он отключается и выполняет некоторую работу до тех пор, пока не выполнит рекурсивный вызов, который, в свою очередь, вернет другой преобразователь. Это стиль трамплина, и функция, которая «отскакивает» от наших преобразователей, - это trampoline. Возвращение преобразователя каждый раз, когда мы выполняем рекурсивный вызов, ограничивает размер нашего стека одним вызовом за раз, поэтому нашим единственным ограничением является куча:

(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 здесь настоящая звезда. Он позволяет вам определять свой алгоритм с ясностью естественной рекурсии и с помощью сохраняющих правильность преобразований эффективно выражать его на любом хосте, имеющем один цикл и кучу.

Вы не можете сделать это с фиксированным объемом памяти. Вы можете использовать стек или кучу; это решение, которое вы должны принять. Если бы я писал это на 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)))