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

Question

tengo un tipo tree definido de la siguiente manera

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

que tienen 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)) 
;; 

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

Answer 1

Puede hacer esto trivialmente al convertir la función en CPS (Continuing Passing Style). La idea es que en lugar de llamar al depth left y luego calcular las cosas en función de este resultado, llame al depth left (fun dleft -> ...), donde el segundo argumento es "qué se debe 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 de la bolsa es "desfuncionalizar" el resultado de CPS. La representación de las continuaciones (las partes (fun dleft -> ...)) como funciones es clara, 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 sólo vuelve a utilizar las variables de entorno right y k, (fun dright -> ...), que reutiliza k y de la izquierda, ahora disponible consecuencia dleft y (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 defunctorized 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 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 
;; 

En lugar de construir una función k y su aplicación en las hojas (k 0), construyo un dato de tipo ('a, int) cont, que tiene que ser más tarde eval uated para calcular un resultado. eval, cuando se pasa un Kleft, hace lo que estaba haciendo el cierre (fun dleft -> ...), es decir, recursivamente llama al depth en el subárbol derecho. 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 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 [] 
;; 

Y una lista es una pila. Lo que tenemos aquí es en realidad una reificación (transformación en datos) de la pila 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 es posible que se representen de forma 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.

Answer 2

En este caso (cálculo de profundidad), que puede acumular más de pares (subtree depth * subtree content) para obtener la siguiente cola-recursivo función:

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 los casos más generales, que de hecho se necesita usar el Transformación CPS descrita por Gabriel.

Answer 3

Hay una solución clara y simple y genérica utilizando fold_tree y CPS - estilo continuo paso:

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