From: Siraaj Khandkar <siraaj@khandkar.net>
Date: Wed, 18 Apr 2018 15:39:14 +0000 (-0400)
Subject: Complete 1.01.e.1.c: demo unbalanced behaviour
X-Git-Url: https://git.xandkar.net/?p=tiger.ml.git;a=commitdiff_plain;h=a18c3a18123408cc53612efcd63a36a0885c773d

Complete 1.01.e.1.c: demo unbalanced behaviour
---

diff --git a/README.md b/README.md
index 1bbb6f8..0d2ea06 100644
--- a/README.md
+++ b/README.md
@@ -19,7 +19,7 @@ Project Plan
 | [-]    | 1.01.e     | --- Exercises                            | 002   | --       | --     | ---------- | ---------- |
 | [x]    | 1.01.e.1.a | ---- tree member                         | ---   | --       | --     | 2018-04-17 | 2018-04-17 |
 | [x]    | 1.01.e.1.b | ---- tree key/val                        | ---   | --       | --     | 2018-04-18 | 2018-04-18 |
-| [ ]    | 1.01.e.1.c | ---- demo unbalanced behaviour           | ---   | --       | --     | ---------- | ---------- |
+| [x]    | 1.01.e.1.c | ---- demo unbalanced behaviour           | ---   | --       | --     | 2018-04-18 | 2018-04-18 |
 | [ ]    | 1.01.e.1.d | ---- find functional balanced tree       | ---   | --       | --     | ---------- | ---------- |
 | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- |
 | [ ]    | 1.02       | -- Lexical Analysis                      | 024   | 01       | --     | ---------- | ---------- |
diff --git a/exercises/ch01/tree.ml b/exercises/ch01/tree.ml
index 6b0ab43..94c2924 100644
--- a/exercises/ch01/tree.ml
+++ b/exercises/ch01/tree.ml
@@ -1,4 +1,5 @@
 module Array = ArrayLabels
+module List = ListLabels
 
 module type TREE = sig
   type ('k, 'v) t
@@ -10,6 +11,12 @@ module type TREE = sig
   val get : ('k, 'v) t -> k:'k -> 'v option
 
   val member : ('k, 'v) t -> k:'k -> bool
+
+  val print
+    : ('k, 'v) t
+    -> k_to_string:('k -> string)
+    -> indent_level:string
+    -> unit
 end
 
 module BinaryTree : TREE = struct
@@ -39,6 +46,23 @@ module BinaryTree : TREE = struct
     | Node (k', _, l, _) when k < k' -> member l ~k
     | Node (k', _, _, r) when k > k' -> member r ~k
     | Node _ -> true
+
+  let rec fold t ~f ~init:acc =
+    match t with
+    | Leaf -> acc
+    | Node (k, v, l, r) -> fold r ~f ~init:(f (fold l ~f ~init:acc) (k, v))
+
+  let print t ~k_to_string ~indent_level =
+    let (_, nodes) =
+      fold t
+        ~f:(fun (indentation, nodes) (k, _) ->
+            let indentation = indent_level ^ indentation in
+            let node = indentation ^ (k_to_string k) in
+            (indentation, node :: nodes)
+          )
+        ~init:(indent_level, [])
+    in
+    List.iter (List.rev nodes) ~f:print_endline
 end
 
 let () =
@@ -55,4 +79,5 @@ let () =
       ~init:BinaryTree.empty
       ~f:(fun t k -> BinaryTree.set t ~k ~v:())
   in
-  Printf.printf "%B\n" (BinaryTree.member tree_b ~k:"a")
+  Printf.printf "%B\n" (BinaryTree.member tree_b ~k:"a");
+  BinaryTree.print tree_b ~k_to_string:(fun x -> x) ~indent_level:"-";