From 8dd2823829e0b265bd01002a3d6eba0897d7885e Mon Sep 17 00:00:00 2001 From: Siraaj Khandkar Date: Wed, 18 Apr 2018 09:17:05 -0400 Subject: [PATCH] Complete 1.01.e.1.b: binary tree key->value set/get --- README.md | 4 ++-- exercises/ch01/tree.ml | 50 ++++++++++++++++++++++++++++-------------- 2 files changed, 35 insertions(+), 19 deletions(-) diff --git a/README.md b/README.md index 97ae9f6..ce3196c 100644 --- a/README.md +++ b/README.md @@ -17,8 +17,8 @@ Project Plan | [x] | 1.01.p.1 | ---- interpreter: maxargs | --- | -- | -- | 2018-04-17 | 2018-04-17 | | [x] | 1.01.p.2 | ---- interpreter: interp | --- | -- | -- | 2018-04-17 | 2018-04-17 | | [-] | 1.01.e | --- Exercises | 002 | -- | -- | ---------- | ---------- | -| [x] | 1.01.e.1.a | ---- tree member | --- | -- | -- | ---------- | ---------- | -| [ ] | 1.01.e.1.b | ---- tree key/val | --- | -- | -- | ---------- | ---------- | +| [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 | --- | -- | -- | ---------- | ---------- | | [ ] | 1.01.e.1.d | ---- find functional balanced tree | --- | -- | -- | ---------- | ---------- | | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- | diff --git a/exercises/ch01/tree.ml b/exercises/ch01/tree.ml index 7cc7d8c..6b0ab43 100644 --- a/exercises/ch01/tree.ml +++ b/exercises/ch01/tree.ml @@ -1,42 +1,58 @@ module Array = ArrayLabels module type TREE = sig - type 'a t + type ('k, 'v) t - val empty : 'a t + val empty : ('k, 'v) t - val add : 'a t -> 'a -> 'a t + val set : ('k, 'v) t -> k:'k -> v:'v -> ('k, 'v) t - val member : 'a t -> 'a -> bool + val get : ('k, 'v) t -> k:'k -> 'v option + + val member : ('k, 'v) t -> k:'k -> bool end module BinaryTree : TREE = struct - type 'a t = - | Node of 'a * 'a t * 'a t + type ('k, 'v) t = + | Node of 'k * 'v * ('k, 'v) t * ('k, 'v) t | Leaf let empty = Leaf - let rec add t x = + let rec set t ~k ~v = + match t with + | Leaf -> Node (k, v, Leaf, Leaf) + | Node (k', v', l, r) when k < k' -> Node (k', v', set l ~k ~v, r) + | Node (k', v', l, r) when k > k' -> Node (k', v', l, set r ~k ~v) + | Node (k, _, l, r) -> Node (k, v, l, r) + + let rec get t ~k = match t with - | Leaf -> Node (x, Leaf, Leaf) - | Node (x', left, right) when x < x' -> Node (x', add left x, right) - | Node (x', left, right) when x > x' -> Node (x', left, add right x) - | (Node _) as t' -> t' + | Leaf -> None + | Node (k', _, l, _) when k < k' -> get l ~k + | Node (k', _, _, r) when k > k' -> get r ~k + | Node (_, v, _, _) -> Some v - let rec member t x = + let rec member t ~k = match t with | Leaf -> false - | Node (x', left, _) when x < x' -> member left x - | Node (x', _, right) when x > x' -> member right x + | Node (k', _, l, _) when k < k' -> member l ~k + | Node (k', _, _, r) when k > k' -> member r ~k | Node _ -> true end let () = - let tree = + let tree_a = BinaryTree.empty in + let tree_a = BinaryTree.set tree_a ~k:"k1" ~v:"v1" in + let tree_a = BinaryTree.set tree_a ~k:"k2" ~v:"v2" in + assert (BinaryTree.member tree_a ~k:"k1"); + assert (BinaryTree.member tree_a ~k:"k2"); + assert (Some "v1" = BinaryTree.get tree_a ~k:"k1"); + assert (Some "v2" = BinaryTree.get tree_a ~k:"k2"); + let tree_b = Array.fold_left (Sys.argv) ~init:BinaryTree.empty - ~f:(fun t str -> BinaryTree.add t str) + ~f:(fun t k -> BinaryTree.set t ~k ~v:()) in - Printf.printf "%B\n" (BinaryTree.member tree "a") + Printf.printf "%B\n" (BinaryTree.member tree_b ~k:"a") -- 2.20.1