funclang series5: Added insert and lookup function for Red-Black tree.

funclang-taddeus/series5/ass11.ml

+type color = Red | Black
+type 'a rbtree = Leaf | Node of 'a * color * 'a rbtree * 'a rbtree
+
+(* Balance a node by matching it against the four cases and returning a new,
+ * well-structured node *)
+let balance_node node = match node with
+    Node (z, Black, Node (y, Red, Node (x, Red, a, b), c), d)
+    | Node (z, Black, Node (x, Red, a, Node (y, Red, b, c)), d)
+    | Node (x, Black, a, Node (z, Red, Node (y, Red, b, c), d))
+    | Node (x, Black, a, Node (y, Red, b, Node (z, Red, c, d))) ->
+        Node (y, Red, Node (x, Black, a, b), Node (z, Black, c, d))
+    | Node (a, b, c, d) -> node
+    | Leaf -> raise (Failure "Cannot balance a leaf")
+
+(* 'a rbtree -> 'a -> 'a rbtree *)
+let insert tree value =
+    let rec insert_in_tree = function
+        (* Insert new Node at leaf position *)
+        Leaf -> Node (value, Red, Leaf, Leaf)
+        | Node (v, color, left, right) ->
+            if value = v then
+                (* Value has already been inserted *)
+                tree
+            else if value < v then
+                (* Inserted value is smaller, insert in left tree *)
+                balance_node (Node (v, color, insert_in_tree left, right))
+            else
+                (* Inserted value is larger, insert in right tree *)
+                balance_node (Node (v, color, left, insert_in_tree right))
+    in
+    match insert_in_tree tree with
+    (* Color the root black *)
+    Node (v, _, left, right) -> Node (v, Black, left, right)
+    | Leaf -> raise (Failure "Error during insertion")
+
+(* 'a -> 'a rbtree -> bool *)
+let rec lookup value = function
+    Leaf -> false
+    | Node (v, _, left, right) -> v = value
+        || (if value < v then lookup value left else lookup value right)
+
+let a = Leaf
+let a = insert a 13
+let a = insert a 8
+let a = insert a 17
+let a = insert a 1
+let a = insert a 11
+let a = insert a 15
+let a = insert a 6
+let a = insert a 22
+let a = insert a 27