Хвост рекурсивная функция, чтобы найти глубину дерева в Ocaml

Question

У меня есть тип 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))
;;

Эта функция не является хвостовой рекурсивной. Есть ли способ для меня, чтобы написать эту функцию в хвостовой рекурсивной форме?

Answer 1

Это можно сделать тривиально, превратив функцию в CPS (стиль продолжения продолжения). Идея в том, чтобы вместо вызова 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)

Это хорошо известный трюк, который может сделать любую функцию рекурсивной. Вуаля, это хвостовой отчет.

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

Answer 2

В этом случае (вычисление глубины) вы можете накапливаться по парам (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, описанное Габриэлем.

Answer 3

Есть аккуратное и универсальное решение, использующее 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