Commit | Line | Data |
---|---|---|
88cc262a SK |
1 | module List = ListLabels |
2 | ||
3 | type ('k, 'v) t = | |
4 | | Node of 'k * 'v * ('k, 'v) t * ('k, 'v) t | |
5 | | Leaf | |
6 | ||
7 | let empty = Leaf | |
8 | ||
9 | let rec set t ~k ~v = | |
10 | match t with | |
11 | | Leaf -> Node (k, v, Leaf, Leaf) | |
12 | | Node (k', v', l, r) when k < k' -> Node (k', v', set l ~k ~v, r) | |
13 | | Node (k', v', l, r) when k > k' -> Node (k', v', l, set r ~k ~v) | |
14 | | Node (k, _, l, r) -> Node (k, v, l, r) | |
15 | ||
16 | let rec get t ~k = | |
17 | match t with | |
18 | | Leaf -> None | |
19 | | Node (k', _, l, _) when k < k' -> get l ~k | |
20 | | Node (k', _, _, r) when k > k' -> get r ~k | |
21 | | Node (_, v, _, _) -> Some v | |
22 | ||
23 | let rec member t ~k = | |
24 | match t with | |
25 | | Leaf -> false | |
26 | | Node (k', _, l, _) when k < k' -> member l ~k | |
27 | | Node (k', _, _, r) when k > k' -> member r ~k | |
28 | | Node _ -> true | |
29 | ||
30 | let to_edges t = | |
31 | let rec to_edges_from k1 t = | |
32 | match t with | |
33 | | Leaf -> [] | |
34 | | Node (k2, _, l, r) -> | |
35 | (k1, k2) :: ((to_edges_from k2 l) @ (to_edges_from k2 r)) | |
36 | in | |
37 | match t with | |
38 | | Leaf -> [] | |
39 | | Node (k, _, l, r) -> (to_edges_from k l) @ (to_edges_from k r) | |
40 | ||
41 | let to_dot t ~k_to_string = | |
42 | let (edges, _) = | |
43 | List.fold_left (to_edges t) | |
44 | ~init:("", "\n") | |
45 | ~f:(fun (edges, sep) (k1, k2) -> | |
46 | let k1, k2 = k_to_string k1, k_to_string k2 in | |
47 | (Printf.sprintf "%s%s %S -> %S;\n" edges sep k1 k2, "") | |
48 | ) | |
49 | in | |
50 | "digraph G {" ^ edges ^ "}" |