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

Tengo un tipo tree definido como sigue

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 manera para mí de escribir esta función en forma recursiva de cola?

Author: Will Ness, 2012-02-17
Source

3 answers

Puede hacer esto trivialmente convirtiendo la función en CPS (Estilo de Paso de Continuación). La idea es que en lugar de llamar depth left, y luego calcular las cosas en base a este resultado, se llama 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 bien conocido que puede hacer que cualquier función de cola recursiva. Voilà, es tail-rec.

El siguiente truco conocido en la bolsa es "defuncionalizar" el resultado de CPS. El la representación de las continuaciones (las partes (fun dleft -> ...)) como funciones es ordenada, pero es posible que desee ver cómo se ve como datos. Así que 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 y k, (fun dright -> ...), que reutiliza k y el resultado de la izquierda ahora disponible 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 defuntorizada 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 aplicarla en las hojas (k 0), construyo un dato de tipo ('a, int) cont, que necesita ser posteriormente evaluated para calcular un resultado. eval, cuando se le pasa un Kleft, hace lo que el cierre (fun dleft -> ...) estaba haciendo, es decir, llama recursivamente depth en el subárbol derecho. eval y depth son mutuamente recursivos.

Ahora mira detenidamente ('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 no tailrec.

Tenga en cuenta que la defuncionalizació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 ser asignados en la memoria, pero así son elementos de ('a, 'b) cont albeit aunque podrían estar representados de forma más compacta". Me apegaría a la versión de CPS a menos que haya muy buenas razones para hacer algo más complicado.

 41
Author: gasche,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2012-02-17 05:34:44

En este caso (cálculo de profundidad), puede acumular sobre pares (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 de CPS descrita por Gabriel.

 16
Author: Thomas,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2017-01-17 02:33:31

Hay una solución ordenada y genérica usando fold_tree y el estilo de paso continuo 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
 0
Author: Viet,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2017-03-19 13:40:49