Commit | Line | Data |
---|---|---|
f76c63f8 | 1 | module Array = ArrayLabels |
a18c3a18 | 2 | module List = ListLabels |
f76c63f8 SK |
3 | |
4 | module type TREE = sig | |
8dd28238 | 5 | type ('k, 'v) t |
f76c63f8 | 6 | |
8dd28238 | 7 | val empty : ('k, 'v) t |
f76c63f8 | 8 | |
8dd28238 | 9 | val set : ('k, 'v) t -> k:'k -> v:'v -> ('k, 'v) t |
f76c63f8 | 10 | |
8dd28238 SK |
11 | val get : ('k, 'v) t -> k:'k -> 'v option |
12 | ||
13 | val member : ('k, 'v) t -> k:'k -> bool | |
a18c3a18 | 14 | |
564eb9f3 | 15 | val to_dot : ('k, 'v) t -> k_to_string:('k -> string) -> string |
f76c63f8 SK |
16 | end |
17 | ||
18 | module BinaryTree : TREE = struct | |
8dd28238 SK |
19 | type ('k, 'v) t = |
20 | | Node of 'k * 'v * ('k, 'v) t * ('k, 'v) t | |
f76c63f8 SK |
21 | | Leaf |
22 | ||
23 | let empty = Leaf | |
24 | ||
8dd28238 SK |
25 | let rec set t ~k ~v = |
26 | match t with | |
27 | | Leaf -> Node (k, v, Leaf, Leaf) | |
28 | | Node (k', v', l, r) when k < k' -> Node (k', v', set l ~k ~v, r) | |
29 | | Node (k', v', l, r) when k > k' -> Node (k', v', l, set r ~k ~v) | |
30 | | Node (k, _, l, r) -> Node (k, v, l, r) | |
31 | ||
32 | let rec get t ~k = | |
f76c63f8 | 33 | match t with |
8dd28238 SK |
34 | | Leaf -> None |
35 | | Node (k', _, l, _) when k < k' -> get l ~k | |
36 | | Node (k', _, _, r) when k > k' -> get r ~k | |
37 | | Node (_, v, _, _) -> Some v | |
f76c63f8 | 38 | |
8dd28238 | 39 | let rec member t ~k = |
f76c63f8 SK |
40 | match t with |
41 | | Leaf -> false | |
8dd28238 SK |
42 | | Node (k', _, l, _) when k < k' -> member l ~k |
43 | | Node (k', _, _, r) when k > k' -> member r ~k | |
f76c63f8 | 44 | | Node _ -> true |
a18c3a18 | 45 | |
564eb9f3 SK |
46 | let to_edges t = |
47 | let rec to_edges_from k1 t = | |
48 | match t with | |
49 | | Leaf -> [] | |
50 | | Node (k2, _, l, r) -> | |
51 | (k1, k2) :: ((to_edges_from k2 l) @ (to_edges_from k2 r)) | |
52 | in | |
a18c3a18 | 53 | match t with |
564eb9f3 SK |
54 | | Leaf -> [] |
55 | | Node (k, _, l, r) -> (to_edges_from k l) @ (to_edges_from k r) | |
a18c3a18 | 56 | |
564eb9f3 SK |
57 | let to_dot t ~k_to_string = |
58 | let (edges, _) = | |
59 | List.fold_left (to_edges t) | |
60 | ~init:("", "\n") | |
61 | ~f:(fun (edges, sep) (k1, k2) -> | |
62 | let k1, k2 = k_to_string k1, k_to_string k2 in | |
06d3ef4a | 63 | (Printf.sprintf "%s%s %S -> %S;\n" edges sep k1 k2, "") |
564eb9f3 | 64 | ) |
a18c3a18 | 65 | in |
564eb9f3 | 66 | "digraph G {" ^ edges ^ "}" |
f76c63f8 SK |
67 | end |
68 | ||
69 | let () = | |
8dd28238 SK |
70 | let tree_a = BinaryTree.empty in |
71 | let tree_a = BinaryTree.set tree_a ~k:"k1" ~v:"v1" in | |
72 | let tree_a = BinaryTree.set tree_a ~k:"k2" ~v:"v2" in | |
73 | assert (BinaryTree.member tree_a ~k:"k1"); | |
74 | assert (BinaryTree.member tree_a ~k:"k2"); | |
75 | assert (Some "v1" = BinaryTree.get tree_a ~k:"k1"); | |
76 | assert (Some "v2" = BinaryTree.get tree_a ~k:"k2"); | |
77 | let tree_b = | |
564eb9f3 | 78 | Array.fold_left (Sys.argv) |
f76c63f8 | 79 | ~init:BinaryTree.empty |
8dd28238 | 80 | ~f:(fun t k -> BinaryTree.set t ~k ~v:()) |
f76c63f8 | 81 | in |
564eb9f3 | 82 | print_endline (BinaryTree.to_dot tree_b ~k_to_string:(fun x -> x)) |