Cornell cs3110 - Chapter5 Exercises

(* Exercise: complex synonym *)
module type ComplexSig = sig
  type complex
  val zero : complex 
  val add : complex -> complex -> complex 
end

(* Exercise: complex encapsulation *)
module Complex : ComplexSig = struct
  type complex = float * float
  let zero = (0.0, 0.0)
  let add = fun (a, b) (c, d) -> (a +. c, b +. d)
  (* 不实现其中任何一项都会造成 The value "..." is required but not provided *)
end

(* Exercise: big list queue *)
module type QueueSig = sig
  type 'a queue
  val empty : 'a queue
  val enqueue : 'a -> 'a queue -> 'a queue
  val dequeue : 'a queue -> 'a * 'a queue
end

module ListQueue : QueueSig = struct
  type 'a queue = 'a list
  let empty = []
  let enqueue x q = q @ [x] (* Linear time *)
  let dequeue q = match q with
    | [] -> raise (Failure "empty queue")
    | x::xs -> (x, xs) (* Constant time *)
end

(* Exercise: binary search tree map *)
(* 用二叉搜索树的概念实现一个类似于 Map 的支持键值对操作的数据结构 比如查询 插入 *)
module type BstMap = sig
  type ('k, 'v) bstmap
  val empty : ('k, 'v) bstmap
  val insert : 'k -> 'v -> ('k, 'v) bstmap -> ('k, 'v) bstmap
  val lookup : 'k -> ('k, 'v) bstmap -> 'v option
  val create : ('k * 'v) list -> ('k, 'v) bstmap
end

module BstMapImpl : BstMap = struct
  type ('k, 'v) bstmap = 
    | Leaf
    | Node of ('k * 'v) * ('k, 'v) bstmap * ('k, 'v) bstmap
  let empty = Leaf
  let rec insert k v = function
    | Leaf -> Node ((k, v), Leaf, Leaf)
    | Node ((k', v'), left, right) -> 
      if k = k' then Node ((k, v), left, right)
      else if k < k' then Node ((k', v'), insert k v left, right)
      else Node ((k', v'), left, insert k v right)
  let rec lookup k = function
    | Leaf -> None
    | Node ((k', v'), left, right) -> 
      if k = k' then Some v'
      else if k < k' then lookup k left
      else lookup k right
  let create lst = List.fold_left (fun acc (k, v) -> insert k v acc) empty lst
end 

(* Exercise: fraction *)
module type FractionSig = sig
  (* A fraction is a rational number p/q, where q != 0. *)
  type t
  (* [make n d] is n/d. Requires d != 0. *)
  val make : int -> int -> t
  val numerator : t -> int 
  val denumerator : t -> int 
  val to_string : t -> string 
  val to_float : t -> float 
  val add : t -> t -> t
  val mul : t -> t -> t
end

module Fraction : FractionSig = struct
  type t = int * int 
  let make n d = if d = 0 then raise (Failure "denumerator cannot be zero") else (n, d)
  let numerator f = fst f
  let denumerator f = snd f
  let to_string f = (numerator f |> string_of_int) ^ "/" ^ (denumerator f |> string_of_int)
  let to_float f = (float_of_int (numerator f)) /. (float_of_int (denumerator f))
  let add f1 f2 = make (numerator f1 * denumerator f2 + numerator f2 * denumerator f1) (denumerator f1 * denumerator f2)
  let mul f1 f2 = make (numerator f1 * numerator f2) (denumerator f1 * denumerator f2)
end

(* Exercise: fraction reduced *)
let rec gcd x y =
  if y = 0 then x else gcd y (x mod y)

let reduce f = 
  if fst f > 0 && snd f < 0 then 
    let g = gcd (abs (fst f)) (abs (snd f)) in
    (- fst f / g, - snd f / g)
  else if fst f < 0 && snd f < 0 then 
    let g = gcd (abs (fst f)) (abs (snd f)) in
    (fst f / g, snd f / g)
  else 
    let g = gcd (abs (fst f)) (abs (snd f)) in
    (fst f / g, snd f / g)

(* Applying these two functions in Fraction will help *)

(* Exercise: make char map *)
module CharMap = Map.Make(Char)
(* Typing it in utop, which will display all types and methods declared *)

(* Exercise: use char map *)
let char_map = CharMap.(empty |> add 'A' "Alpha" |> add 'B' "Beta")
let char_map_mem = CharMap.mem 'A' char_map
let char_map_bindings = CharMap.bindings char_map

(* Exercise: date order *)
type date = {month : int; day : int}

module Date = struct
  type t = date
  let compare d1 d2 = 
    if d1.month = d2.month then d1.day - d2.day
    else d1.month - d2.month
end

(* Exercise: calendar *)
module DateMap = Map.Make(Date)

type calendar = string DateMap.t

let calendar : calendar = DateMap.empty |> DateMap.add {month = 1; day = 1} "New Year" |> DateMap.add {month = 2; day = 14} "Valentine's Day"

let calendar_bindings = DateMap.bindings calendar

(* Exercise: print calendar *)

let print_calendar calendar = 
  DateMap.iter (fun date event -> Printf.printf "%d/%d: %s\n" date.month date.day event) calendar

(* Exercise: is for *)
let is_for : string CharMap.t -> string CharMap.t = fun m -> 
  CharMap.fold (fun k v acc -> CharMap.add k ("I am for " ^ v) acc) m CharMap.empty

(* Exercise: first after *)
let first_after : calendar -> Date.t -> string = fun calendar date -> DateMap.find_first (fun d -> Date.compare d date > 0) calendar |> snd

(* Exercise: first after *)

(* Exercise: sets *)
module CaseIntendSet = struct
  type t = string
  let compare x y = String.compare (String.lowercase_ascii x) (String.lowercase_ascii y)
end

module CaseIntendSet = Set.Make(CaseIntendSet)

(* Exercise: ToString *)
module type ToStringSig = sig
  type t 
  val to_string : t -> string
end

(* Exercise: Print *)
module Print (M : ToStringSig) = struct
  let print x = print_endline (M.to_string x)
end

(* Exercise: Print Int *)
module IntForPrint = struct
  type t = int 
  let to_string = string_of_int
end

module PrintInt = Print(IntForPrint)