exercises/ch01/tree_unbalanced_vanilla.ml

   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 ^ "}"