ch5

module type ComplexSig = sig
  val zero : float * float
  val add : float * float -> float * float -> float * float
end

module type ComplexSig = sig
  type t = float * float
  val zero : t
  val add : t -> t -> t
end

module Complex : ComplexSig = struct
  type t = float * float
  let zero = (0., 0.)
  let add (r1, i1) (r2, i2) = r1 +. r2, i1 +. i2
end

Error: Signature mismatch:
       Modules do not match:
         sig type t = float * float val zero : float * float end
       is not included in
         ComplexSig
       The value `add' is required but not provided 

Error: Signature mismatch:
       ...
       Values do not match:
         val zero : int * int
       is not included in
         val zero : t

  module type Queue = sig
    type 'a t
    exception EmptyQueue
    val empty : 'a t
    val is_empty : 'a t -> bool
    val size : 'a t -> int
    val enqueue : 'a -> 'a t -> 'a t
    val front : 'a t -> 'a
    val dequeue : 'a t -> 'a t
    val to_list : 'a t -> 'a list 
  end

module ListQueue : Queue = struct
  type 'a t = 'a list
  exception EmptyQueue
  let empty = []
  let is_empty = function
    | [] -> true
    | _ -> false
  let size = List.length

  let enqueue e q = q @ [e]  (* !! *)
  let front = function
    | [] -> raise EmptyQueue
    | h::_ -> h
  let dequeue = function
    | [] -> raise EmptyQueue
    | _::t -> t 
  let to_list = Fun.id (* 恒等映射 *)
end

(** Creates a ListQueue filled with [n] elements. *)
let fill_listqueue n =
  let rec loop n q =
    if n = 0 then q
    else loop (n - 1) (ListQueue.enqueue n q) in
  loop n ListQueue.empty
;;

module  BatchedQueue = struct

  type 'a queue = {
    front: 'a list ;
    back: 'a list 
  }

  let empty = {
    front= [];
    back = []
  }

  let peek = function
    |{front=[] } -> None
    |{front=x::_ ;} -> Some x


  let enqueue x = function
    |{front=[] } -> {front=[x] ; back=[] }
    |q -> {q with back=x::q.back}  (* 即：当front不为空list时*)

  let dequeue = function
    |{front=[]} -> None
    |{front= _::[] ;back=b} -> Some {front = List.rev b ;back=[] } 
    |{front=_::t;back=b} -> Some {front = t ;back=b}

end

let fill_batchedqueue n =
  let rec loop n q =
    if n = 0 then q
    else loop (n - 1) (BatchedQueue.enqueue n q) in
  loop n BatchedQueue.empty

module type Map = sig
  exception Empty
  type ('k,'v ) t
  val empty : ('k,'v) t
  val insert : 'k -> 'v -> ('k,'v) t -> ('k,'v) t
  val lookup : 'k -> ('k,'v) t -> 'v 
  val bindings : ('k,'v) t -> ('k * 'v) list  
end ;;


module BstMapImpl = struct
  exception Empty
  type ('k,'v) t = Leaf | Node of ('k * 'v) * ('k,'v) t * ('k,'v) t 
  let empty = Leaf
  let rec  insert key value = function
    | Leaf -> Node ( (key,value) ,Leaf,Leaf)
    | Node ((k,v),l,r) when key < k ->  Node((k,v),(insert key value l),r) 
    | Node ((k,v),l,r) when key > k ->   Node((k,v),l,(insert key value r))
    | Node ((k,v),l,r) -> Node((k,value),l,r)

  let rec lookup key = function
    | Leaf -> raise  Empty
    | Node ((k,_),l,_) when key < k ->  lookup key l
    | Node ((k,_),_,r) when key > k -> lookup key r
    | Node ((_,v),_,_) -> v

  let bindings m  =
    let rec bindings_aux acc  = function
    | Leaf -> acc 
    | Node((k,v),l,r) ->  (bindings_aux (bindings_aux ((k,v)::acc)  l) r)
    in
    bindings_aux [] m 
end

module BstMap:Map = BstMapImpl ;;

# BstMapImpl. (empty |> insert 1 "hello" |> insert 2 "fuck" |> insert 4 "dead" |> lookup 2 ) ;;
- : string = "fuck"

# BstMapImpl. (empty |> insert 1 "hello" |> insert 2 "fuck" |> insert 4 "dead" |> bindings  ) ;; 
- : (int * string) list = [(4, "dead"); (2, "fuck"); (1, "hello")]

module type Fraction = 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 denominator : t -> int
  val to_string : t -> string
  val to_float : t -> float

  val add : t -> t -> t
  val mul : t -> t -> t
end


module TupleFraction : Fraction = struct
  type t = int * int

  let make n d =if d=0 then raise Division_by_zero else  (n ,d )
  let numerator (n,d) = n
  let denominator (n,d) = d
  let to_string (n,d) = ( string_of_int n ) ^ "/" ^ (string_of_int d)
  let to_float (n,d) = (float_of_int n) /. (float_of_int d)

  let add (n,d) (n',d') =  (n*d' + n' *d , d*d' )
  let mul (n,d) (n',d') = (n*n'  ,d*d') 
end

(** [gcd x y] is the greatest common divisor of [x] and [y].
    Requires: [x] and [y] are positive. *)
let rec gcd x y =
  if x = 0 then y
  else if (x < y) then gcd (y - x) x
  else gcd y (x - y)

module ReducedFraction : Fraction = struct
    type t = int * int

    let rec mygcd x y = 
      if x mod y = 0 then y 
      else if x < y then mygcd y x 
      else  mygcd y (x mod y)

    let reduce (n,d) = let g = mygcd n d in (n/g, d/g ) 
    let make n d =if d=0 then raise Division_by_zero else reduce (n,d)


    let numerator (n,d) = n
    let denominator (n,d) = d
    let to_string (n,d) = ( string_of_int n ) ^ "/" ^ (string_of_int d)
    let to_float (n,d) = (float_of_int n) /. (float_of_int d)

    let add (n,d) (n',d') =  reduce (n*d' + n' *d , d*d' )
    let mul (n,d) (n',d') = reduce (n*n'  ,d*d') 
  end

module CharMap = Map.Make(Char) ;; 

module CharMap :
  sig
    type key = Char.t
    type 'a t = 'a Map.Make(Char).t
   ...
    val empty : 'a t
    val add : key -> 'a -> 'a t -> 'a t
    val remove : key -> 'a t -> 'a t
        ...
end

type t = char 
(**  An alias for the type of characters. *)

val compare : t -> t -> int
(**  The comparison function for characters, with the same specification as compare. Along with the type t, this function compare allows the module Char to be passed as argument to the functors Set.Make and Map.Make. *)

let m = CharMap. (empty |> add 'A' "Alpha" |> add 'E' "echo" |> add 'S' "Sierra" |> add 'V' "Victor" ) ;;

CharMap.find 'E' m ;;
(** - : string = "echo" *)
m |>  CharMap.remove 'A' |>  CharMap.mem 'A';;
(** - : bool = false *)
CharMap.bindings m ;;
(** [(A, "Alpha"); (E, "echo"); (S, "Sierra"); (V, "Victor")] *)

type date = {month : int; day : int}

module Date = struct
  type date = {month :int ; day : int} 
  type t = date
  let compare d1 d2 = match (d1.month - d2.month  , d1.day-d2.day) with
    | (m,d) when m > 0 -> 1
    | (m,d) when m < 0 -> -1
    | (0,d) when d > 0 -> 1
    | (0,d) when d < 0 -> -1
    | _ -> 0
end

type calendar = string DateMap.t ;;

DateMap. (empty |> add {month=10;day=12} "my birthday!" |> bindings) ;; 

let print_calendar (cal:calender) =
  DateMap.iter (fun d e -> Printf.printf "%i月%i日: %s \n" d.month d.day e ) cal 

let is_for m =
  CharMap.mapi (fun k v -> Printf.sprintf "%c is for %s" k v ) m
;;

# CharMap. (empty |> add 'a' "apple" |> is_for |> bindings) ;;
- : (CharMap.key * string) list = [(a, "a is for apple")]

let first_after (cal:calendar) (d:Date.t) =
 let (d,e) = DateMap.find_first (fun k -> (Date.compare k d) > 0) cal
 in e
;;

#  first_after (DateMap. (empty |> add {month=10;day=12} "my birthday!" )) {month=10;day=1} ;; 
- : string = "my birthday!"

#  first_after (DateMap. (empty |> add {month=10;day=12} "my birthday!" )) {month=11;day=1} ;; 
Exception: Not_found

module InsStr= struct 
  type t = string
  let compare a b =String. (compare (lowercase_ascii a) (lowercase_ascii b))
end


module InsStrSet = Set.Make(InsStr );; 

module type ToString = sig
  type t
  val to_string : t -> string
end

module Print (M:ToString) = struct
  let print (m:M.t) =
    Printf.printf "%s\n" (M.to_string m)
end

module Int = struct
  type t = int
  let to_string = string_of_int
end

module PrintInt = Print(Int) ;; 

# PrintInt.print 234 ;;
234
- : unit = ()

module MyString = struct
  type t = string
  let to_string = Fun.id
end

module PrintString = Print(MyString) ;; 

# PrintString.print "hello"  ;;
hello
- : unit = ()

module StringWithPrint = struct
  include String
  include Print(MyString) 
end

type date = {month : int; day : int}
let make_date month day = {month; day}
let get_month d = d.month
let get_day d = d.day
let to_string d = (string_of_int d.month) ^ "/" ^ (string_of_int d.day)

(library
 (name date)) 

dune utop 

# open Date ;;

# (make_date 3 5 ) |> get_day ;;
- : int = 5

# (make_date 3 5 ) |> to_string ;;
- : string = "3/5"

type date = {month : int; day : int}
val make_date : int -> int -> date
val get_month : date -> int
val get_day : date -> int
val to_string : date -> string

# open Date ;;

# (make_date 3 6) |> get_day ;;
- : int = 6

# (make_date 3 6) |> to_string ;;
- : string = "3/6"

# let d = make_date 3 6 ;;
val d : date = {month = 3; day = 6}

type date 

# open Date;;

# let d = make_date 3 6 ;;
val d : date = <abstr>

# d |> get_day ;;
- : int = 6

# d |> to_string ;;
- : string = "3/6"

val format : Format.formatter -> date -> unit 

#install_printer Date.format;;

let format f d =
  Format.fprintf f "%s" (to_string d)

utop # #load "date.cmo" ;;

utop # #install_printer  Date.format ;;

utop # open Date ;;

utop # let d = make_date 3 4 ;;
val d : date = 3/4

utop # d |> get_day ;;
- : int = 4

utop # d |> to_string ;;
- : string = "3/4"