update lecture 08 notes

lectures/08/infstream.ml

@@ -4,6 +4,26 @@ let hd (Cons (h, _)) = h
 let tl (Cons (_, t)) = t ()
 
 let rec from n = Cons (n, fun () -> from (n + 1))
+
 let rec take n (Cons (h, t)) =
   if n <= 0 then []
   else h :: take (n - 1) (t ())
+
+let rec drop n (Cons (h, t) as s) =
+  if n <= 0 then s
+  else drop (n - 1) (t ())
+
+let rec map f (Cons (h, t)) =
+  Cons (f h, fun () -> map f (t ()))
+
+let rec map2 f (Cons (h1, t1)) (Cons (h2, t2)) =
+  Cons (f h1 h2, fun () -> map2 f (t1 ()) (t2 ()))
+
+let rec fibs =
+  Cons (0, fun () -> Cons (1, fun () -> map2 (+) fibs (tl fibs)))
+
+let rec unfold f x =
+  let (v, x') = f x in
+  Cons (v, fun () -> unfold f x')
+
+let fibs' = unfold (fun (a, b) -> (a, (b, a + b))) (0, 1)

lectures/08/lazystream.ml

@@ -1,13 +1,17 @@
 type 'a lazystream = Cons of 'a * 'a lazystream Lazy.t
 
-let hd (Cons (h, _)) = h;;
+let hd (Cons (h, _)) = h
-let tl (Cons (_, t)) = Lazy.force t;;
+let tl (Cons (_, t)) = Lazy.force t
 
-let rec from n = Cons (n, lazy (from (n + 1)));;
+let rec from n = Cons (n, lazy (from (n + 1)))
 
 let rec take n (Cons (h, t)) =
   if n <= 0 then []
-  else h :: take (n - 1) (Lazy.force t);;
+  else h :: take (n - 1) (Lazy.force t)
+
+let rec drop n (Cons (h, t) as s) =
+  if n <= 0 then s
+  else drop (n - 1) (Lazy.force t)
 
 let rec map f (Cons (h, t)) =
   Cons (f h, lazy (map f (Lazy.force t)))
@@ -17,3 +21,9 @@ let rec map2 f (Cons (h1, t1)) (Cons (h2, t2)) =
 
 let rec fibs =
   Cons (0, lazy (Cons (1, lazy (map2 (+) fibs (tl fibs)))))
+
+let rec unfold f x =
+  let (v, x') = f x in
+  Cons (v, lazy (unfold f x'))
+
+let fibs' = unfold (fun (a, b) -> (a, (b, a + b))) (0, 1)

lectures/08/rbtree.ml

@@ -1,23 +1,47 @@
 type color = R | B
-
+type 'a t = E | N of (color * 'a t * 'a * 'a t)
-type 'a rbtree = L | N of color * 'a rbtree * 'a * 'a rbtree
 
 let balance = function
   | B, N (R, N (R, a, x, b), y, c), z, d
   | B, N (R, a, x, N (R, b, y, c)), z, d
   | B, a, x, N (R, N (R, b, y, c), z, d)
   | B, a, x, N (R, b, y, N (R, c, z, d)) ->
-    N (R, N (B, a, x, b), y, N (B, c, z, d))
+      N (R, N (B, a, x, b), y, N (B, c, z, d))
   | c, l, x, r ->
-    N (c, l, x, r)
+      N (c, l, x, r)
 
-let insert x t =
+let rec insert x t =
   let rec ins = function
-    | L -> N (R, L, x, L)
+    | E -> N (R, E, x, E)
     | N (c, l, y, r) when x < y ->
-      balance (c, ins l, x, r)
+        balance (c, ins l, y, r)
     | N (c, l, y, r) when x > y ->
-      balance (c, l, x, ins r)
+        balance (c, l, y, ins r)
-    | _ -> t
+    | t -> t
   in
-  ins t
+  match ins t with
+  | E -> failwith "insert: impossible"
+  | N (_, l, y, r) -> N (B, l, y, r)
+
+let of_list l =
+  List.fold_left (Fun.flip insert) E l
+
+let print pr t =
+  let rec aux level t =
+    Printf.printf "%*s" (3 * level) "";
+    match t with
+    | E -> Printf.printf "-\n"
+    | N (c, l, x, r) ->
+        if c = R then (
+          Printf.printf "\u{1b}[1;31m";
+          pr x;
+          Printf.printf "\u{1b}[1;0m\n"
+        )
+        else (
+          pr x;
+          Printf.printf "\n"
+        );
+        aux (level + 1) l;
+        aux (level + 1) r
+  in
+  aux 0 t