# Untitled

By: a guest on Apr 28th, 2012  |  syntax: None  |  size: 1.61 KB  |  hits: 39  |  expires: Never
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
1. Tail recursive function to find depth of a tree in Ocaml
2. type 'a tree = Leaf of 'a | Node of 'a * 'a tree * 'a tree ;;
3.
4. let rec depth = function
5.     | Leaf x -> 0
6.     | Node(_,left,right) -> 1 + (max (depth left) (depth right))
7. ;;
8.
9. let depth tree =
10.   let rec depth tree k = match tree with
11.     | Leaf x -> k 0
12.     | Node(_,left,right) ->
13.       depth left (fun dleft ->
14.         depth right (fun dright ->
15.           k (1 + (max dleft dright))))
16.   in depth tree (fun d -> d)
17.
18. type ('a, 'b) cont =
19.   | Kleft of 'a tree * ('a, 'b) cont (* right and k *)
20.   | Kright of 'b * ('a, 'b) cont     (* dleft and k *)
21.   | Kid
22.
23. let depth tree =
24.   let rec depth tree k = match tree with
25.     | Leaf x -> eval k 0
26.     | Node(_,left,right) ->
27.       depth left (Kleft(right, k))
28.   and eval k d = match k with
29.     | Kleft(right, k) ->
30.       depth right (Kright(d, k))
31.     | Kright(dleft, k) ->
32.       eval k (1 + max d dleft)
33.     | Kid -> d
34.   in depth tree Kid
35. ;;
36.
37. type ('a, 'b) next_item =
38.   | Kleft of 'a tree
39.   | Kright of 'b
40.
41. type ('a, 'b) cont = ('a, 'b) next_item list
42.
43. let depth tree =
44.   let rec depth tree k = match tree with
45.     | Leaf x -> eval k 0
46.     | Node(_,left,right) ->
47.       depth left (Kleft(right) :: k)
48.   and eval k d = match k with
49.     | Kleft(right) :: k ->
50.       depth right (Kright(d) :: k)
51.     | Kright(dleft) :: k ->
52.       eval k (1 + max d dleft)
53.     | [] -> d
54.   in depth tree []
55. ;;
56.
57. let depth t =
58.   let rec aux depth = function
59.     | [] -> depth
60.     | (d, Leaf _) :: t -> aux (max d depth) t
61.     | (d, Node (_,left,right)) :: t ->
62.       let accu = (d+1, left) :: (d+1, right) :: t in
63.       aux depth accu in
64. aux 0 [0, t]