Función recursiva de la cola para encontrar la profundidad de un árbol en Ocaml

Tengo un tree tipos definido de la siguiente manera

 type 'a tree = Leaf of 'a | Node of 'a * 'a tree * 'a tree ;; 

Tengo una función para encontrar la profundidad del árbol de la siguiente manera

 let rec depth = function | Leaf x -> 0 | Node(_,left,right) -> 1 + (max (depth left) (depth right)) ;; 

Esta función no es recursiva de cola. ¿Hay alguna forma de escribir esta función en forma recursiva?

Puede hacer esto trivialmente al convertir la función en CPS (Continuing Passing Style). La idea es que en lugar de llamar depth left y luego calcular cosas basadas en este resultado, se llame depth left (fun dleft -> ...) , donde el segundo argumento es “qué calcular una vez que el resultado ( dleft ) esté disponible “.

 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) 

Este es un truco muy conocido que puede hacer que cualquier función sea recursiva. Voilà, es tail-rec.

El siguiente truco conocido en la bolsa es “desfuncionalizar” el resultado de CPS. La representación de continuaciones (las partes (fun dleft -> ...) como funciones es ordenada, pero es posible que desee ver cómo se ve como datos. Entonces, reemplazamos cada uno de estos cierres por un constructor concreto de un tipo de datos, que captura las variables libres utilizadas en él.

Aquí tenemos tres cierres de continuación: (fun dleft -> depth right (fun dright -> k ...)) , que solo reutiliza las variables de entorno right k , (fun dright -> ...) , que reutiliza k y el resultado izquierdo ahora disponible dleft , y (fun d -> d) dleft (fun d -> d) , el cálculo inicial, que no captura nada.

 type ('a, 'b) cont = | Kleft of 'a tree * ('a, 'b) cont (* right and k *) | Kright of 'b * ('a, 'b) cont (* dleft and k *) | Kid 

La función defunctorizada se ve así:

 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 kd = 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 ;; 

En lugar de construir una función k y aplicarla en las hojas ( k 0 ), construyo una información de tipo ('a, int) cont , que necesita ser eval más tarde para calcular un resultado. eval , cuando se pasa un Kleft , hace lo que estaba haciendo el cierre (fun dleft -> ...) , es decir, recurrentemente a la depth en el subárbol correcto. eval y depth son mutuamente recursivos.

Ahora mira con fuerza en ('a, 'b) cont , ¿qué es este tipo de datos? ¡Es una lista!

 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 kd = match k with | Kleft(right) :: k -> depth right (Kright(d) :: k) | Kright(dleft) :: k -> eval k (1 + max d dleft) | [] -> d in depth tree [] ;; 

Y una lista es una stack. Lo que tenemos aquí es en realidad una reificación (transformación en datos) de la stack de llamadas de la función recursiva anterior, con dos casos diferentes que corresponden a los dos tipos diferentes de llamadas non-tailrec.

Tenga en cuenta que la desfuncionalización solo está ahí por diversión. En la práctica, la versión de CPS es corta, fácil de derivar a mano, bastante fácil de leer, y recomendaría usarla. Los cierres deben asignarse en la memoria, pero también lo son los elementos de ('a, 'b) cont – aunque estos pueden representarse de manera más compacta. Me quedaría con la versión de CPS a menos que haya muy buenas razones para hacer algo más complicado.

En este caso (cómputo de profundidad), puede acumular por pares (contenido del subtree depth subtree content *) para obtener la siguiente función recursiva de cola:

 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)] 

Para casos más generales, de hecho necesitará usar la transformación CPS descrita por Gabriel.

Hay una solución ordenada y genérica que usa fold_tree y CPS: estilo de pase continuo:

 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 @@ fx lacc racc)) in loop tree (fun x -> x) let depth tree = fold_tree tree (fun x dl dr -> 1 + (max dl dr)) 0