У меня есть тип tree, который определяется как
type 'a tree = Leaf of 'a | Node of 'a * 'a tree * 'a tree ;;
У меня есть функция, чтобы найти глубину дерева следующим образом
let rec depth = function
| Leaf x -> 0
| Node(_,left,right) -> 1 + (max (depth left) (depth right))
;;
Эта функция не является рекурсивной. Есть ли способ написать эту функцию хвостовым рекурсивным способом?
Вы можете тривиально сделать это, включив функцию в CPS (Continuation Passing Style). Идея состоит в том, что вместо вызова depth left, а затем вычисления вещей на основе этого результата вы вызываете depth left (fun dleft -> ...), где второй аргумент - "что нужно вычислить, когда результат (dleft) доступен".
let depth tree =
let rec depth tree k = match tree with
| Leaf x -> k 0
| Node(_,left,right) ->
depth left (fun dleft ->
depth right (fun dright ->
k (1 + (max dleft dright))))
in depth tree (fun d -> d)
Это хорошо известный трюк, который может сделать любую функцию хвостовой рекурсивной. Voilà, это хвост.
Следующий известный трюк в сумке - "defunctionalize" результат CPS. Представление продолжений (части (fun dleft -> ...)) как функции опрятно, но вы можете посмотреть, как это выглядит как данные. Поэтому мы заменяем каждое из этих замыканий конкретным конструктором типа данных, который захватывает свободные переменные, используемые в нем.
Здесь мы имеем три закрытия продолжения: (fun dleft -> depth right (fun dright -> k ...)), который только повторно использует переменные среды right и k, (fun dright -> ...), которые повторно используют k и теперь доступный левый результат dleft и (fun d -> d), начальное вычисление, которое ничего не фиксирует.
type ('a, 'b) cont =
| Kleft of 'a tree * ('a, 'b) cont (* right and k *)
| Kright of 'b * ('a, 'b) cont (* dleft and k *)
| Kid
Дефункрированная функция выглядит следующим образом:
let depth tree =
let rec depth tree k = match tree with
| Leaf x -> eval k 0
| Node(_,left,right) ->
depth left (Kleft(right, k))
and eval k d = match k with
| Kleft(right, k) ->
depth right (Kright(d, k))
| Kright(dleft, k) ->
eval k (1 + max d dleft)
| Kid -> d
in depth tree Kid
;;
Вместо того, чтобы строить функцию k и применяя ее на листах (k 0), я строю данные типа ('a, int) cont, которые должны быть позже eval uated для вычисления результата. eval, когда он получает a Kleft, выполняет то, что делал закрытие (fun dleft -> ...), то есть рекурсивно вызывает depth в правом поддереве. eval и depth являются взаимно рекурсивными.
Теперь посмотрите на ('a, 'b) cont, что это за тип данных? Это список!
type ('a, 'b) next_item =
| Kleft of 'a tree
| Kright of 'b
type ('a, 'b) cont = ('a, 'b) next_item list
let depth tree =
let rec depth tree k = match tree with
| Leaf x -> eval k 0
| Node(_,left,right) ->
depth left (Kleft(right) :: k)
and eval k d = match k with
| Kleft(right) :: k ->
depth right (Kright(d) :: k)
| Kright(dleft) :: k ->
eval k (1 + max d dleft)
| [] -> d
in depth tree []
;;
И список - это стек. То, что мы имеем здесь, является на самом деле овеществлением (преобразованием в данные) стека вызовов предыдущей рекурсивной функции с двумя разными случаями, соответствующими двум различным типам не-tailrec-вызовов.
Обратите внимание, что деинтернализация существует только для удовольствия. В правильной версии версия CPS коротка, легко получается вручную, довольно легко читается, и я бы рекомендовал ее использовать. Замыкания должны быть выделены в памяти, но также элементы ('a, 'b) cont - хотя они могут быть представлены более компактно ". Я бы придерживался версии CPS, если нет веских причин сделать что-то более сложное.
В этом случае (вычисление глубины) вы можете накапливать более пары (subtree depth * subtree content), чтобы получить следующую хвосто-рекурсивную функцию:
let depth tree =
let rec aux depth = function
| [] -> depth
| (d, Leaf _) :: t -> aux (max d depth) t
| (d, Node (_,left,right)) :: t ->
let accu = (d+1, left) :: (d+1, right) :: t in
aux depth accu in
aux 0 [(0, tree)]
Для более общих случаев вам действительно понадобится использовать преобразование CPS, описанное Габриэлем.
Существует аккуратное и универсальное решение, использующее стиль fold_tree и CPS - непрерывный проход:
let fold_tree tree f acc =
let loop t cont =
match tree with
| Leaf -> cont acc
| Node (x, left, right) ->
loop left (fun lacc ->
loop right (fun racc ->
cont @@ f x lacc racc))
in loop tree (fun x -> x)
let depth tree = fold_tree tree (fun x dl dr -> 1 + (max dl dr)) 0