diff --git a/lectures/08/infstream.ml b/lectures/08/infstream.ml new file mode 100644 index 0000000..f961197 --- /dev/null +++ b/lectures/08/infstream.ml @@ -0,0 +1,9 @@ +type 'a infstream = Cons of 'a * (unit -> 'a infstream) + +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 ()) diff --git a/lectures/08/lazystream.ml b/lectures/08/lazystream.ml new file mode 100644 index 0000000..50a8395 --- /dev/null +++ b/lectures/08/lazystream.ml @@ -0,0 +1,19 @@ +type 'a lazystream = Cons of 'a * 'a lazystream Lazy.t + +let hd (Cons (h, _)) = h;; +let tl (Cons (_, t)) = Lazy.force t;; + +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);; + +let rec map f (Cons (h, t)) = + Cons (f h, lazy (map f (Lazy.force t))) + +let rec map2 f (Cons (h1, t1)) (Cons (h2, t2)) = + Cons (f h1 h2, lazy (map2 f (Lazy.force t1) (Lazy.force t2))) + +let rec fibs = + Cons (0, lazy (Cons (1, lazy (map2 (+) fibs (tl fibs))))) diff --git a/lectures/08/notes.ml b/lectures/08/notes.ml new file mode 100644 index 0000000..e221480 --- /dev/null +++ b/lectures/08/notes.ml @@ -0,0 +1,82 @@ +(*** INFINITE STREAMS ***) + +(* will blow the stack - infinite *) +let rec from n = n :: from (n + 1) + +(* 1 + 1 is not calculated till we call f *) +let f () = 1 + 1 + +(* apply same logic to from to defer n + 1 *) +(* let rec from n = n :: (fun () -> from (n + 1)) *) + +(* but this results in a type error, so we need to wrap it in a type variance *) +(* this will map the unit type of an anonymouse function to our infinite stream type *) +type 'a infstream = Cons of 'a * (unit -> 'a infstream) + +let rec from n = Cons (n, (fun () -> from (n + 1))) + +(* head and tail of infinite stream *) +let hd (Cons (h, t)) = h +let tl (Cons (h, t)) = t () + +(* natural number (starting from 1) *) +let nats = from 1;; +nats |> tl |> hd + +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 squares = map (fun x -> x * x) nats;; +take 10 squares + +let rec map2 f (Cons (h1, t1)) (Cons (h2, t2)) = + Cons (f h1 h2, fun () -> map2 f (t1 ()) (t2 ())) + +let s = map2 (+) nats squares;; +take 10 s + +let rec fibs = + Cons (0, fun () -> Cons (1, fun () -> map2 (+) fibs (tl fibs)));; + +take 20 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);; + + +(*** Lazy ***) +lazy (1 + 1) +let x = lazy (1 + 1);; +x;; +Lazy.force x;; +x;; + +type 'a lazystream = Cons of 'a * 'a lazystream Lazy.t;; + +let hd (Cons (h, _)) = h;; +let tl (Cons (_, t)) = Lazy.force t;; +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);; + +let nats = from 1;; +nats;; +take 10 nats;; + +let rec drop n (Cons (h, t) as s) = + if n <= 0 then s + else drop (n - 1) (Lazy.force t);; + +drop 5 nats;; diff --git a/lectures/08/rbtree.ml b/lectures/08/rbtree.ml new file mode 100644 index 0000000..1fb76cf --- /dev/null +++ b/lectures/08/rbtree.ml @@ -0,0 +1,23 @@ +type color = R | B + +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)) + | c, l, x, r -> + N (c, l, x, r) + +let insert x t = + let rec ins = function + | L -> N (R, L, x, L) + | N (c, l, y, r) when x < y -> + balance (c, ins l, x, r) + | N (c, l, y, r) when x > y -> + balance (c, l, x, ins r) + | _ -> t + in + ins t