User Tools

Site Tools


ex-types-sol

LiP assignment #5: solutions

1. Rational numbers

# type num = { num: int; den: int};;
 
# let abs n = if n<0 then -n else n;;
val abs : int -> int = <fun>
 
# let gcd x y = 
    let rec gcd_pos n m = 
  	if n=0 then m else 
	if m=0 then n else 
	if n>m then gcd (n-m) m else 
	gcd n (m-n)
    in let n = abs x and m = abs y in gcd_pos n m;;
 
val gcd : int -> int -> int = <fun>
 
# let simplify { num=n; den=d } = 
    let (n',d') = if d<0 then (-n,-d) else (n,d) in
    let m = gcd n' d' in { num = n'/m; den = d'/m };;
 
val simplify : num -> num = <fun>
 
# let lcm a b = abs((a * b) / (gcd a b));;
val lcm : int -> int -> int = <fun>
 
# let add_num { num=n1; den=d1 } { num=n2; den=d2 } =
    let m = lcm d1 d2 
    in simplify { num = n1*(m/d1) + n2*(m/d2); den=m};;
 
val add_num : num -> num -> num = <fun>
 
# let leq_num { num=n1; den=d1 } { num=n2; den=d2 } =
    let sum = add_num { num=n1; den=d1 } { num=(-n2); den=d2 } 
    in sum.num <= 0;;
 
val leq_num : num -> num -> bool = <fun>
 
# add_num { num=2; den=21 } { num=(-1); den=6 };;
- : num = {num = -1; den = 14}
 
# leq_num { num=4; den=(-3) } { num=(2); den=(-3) };;
- : bool = true


2. Card game

# type suit = Spades | Hearts | Diamonds | Clubs;;
# type card = Card of int * suit;;
# type deck = Deck of card list;;
 
# let card_correct (Card (n,s)) = n>=1 && n<=10;;
 
# let rec dup l = match l with
    [] -> false
  | x::xl -> (List.mem x xl) || dup xl;;
 
# let deck_complete (Deck l) = 
    (List.length l) = 40 && 
    not (dup l) && 
    List.fold_right (fun x y -> (card_correct x) && y) l true;;
 
val deck_complete : deck -> bool = <fun>
 
# let rec range a b = if b<a then [] else a::(range (a+1) b);;
 
# let suit_of_int = function
    1 -> Spades
  | 2 -> Hearts
  | 3 -> Diamonds
  | 4 -> Clubs;;
 
# let suitify n = List.map (fun x -> Card(n, suit_of_int x)) (range 1 4);;
val suitify : int -> card list = <fun>
 
# let newdeck = fun () -> Deck (List.flatten (List.map suitify (range 1 10)));;
val newdeck : unit -> deck = <fun>
 
# deck_complete (Deck ([Card(1,Spades); Card(2,Hearts)]));; 
- : bool = false
 
# deck_complete (newdeck());;
- : bool = true
 
# let partition (Deck l) = 
    let suit_filter s = List.filter (fun (Card(n,x)) -> x=s) in
    (Deck(suit_filter Spades l), 
     Deck(suit_filter Hearts l), 
     Deck(suit_filter Diamonds l), 
     Deck(suit_filter Clubs l));;
 
val partition : deck -> deck * deck * deck * deck = <fun>
 
# let string_of_card = function
    Card (n,Spades) -> (string_of_int n) ^ "S"
  | Card (n,Hearts) -> (string_of_int n) ^ "H"
  | Card (n,Diamonds) -> (string_of_int n) ^ "D"
  | Card (n,Clubs) -> (string_of_int n) ^ "C";;
 
# let (Deck ds,Deck dh, Deck dd, Deck dc) = partition (newdeck())
  and f = List.map string_of_card
  in (f ds, f dh, f dd, f dc);;
- : string list * string list * string list * string list =
(["1S"; "2S"; "3S"; "4S"; "5S"; "6S"; "7S"; "8S"; "9S"; "10S"],
 ["1H"; "2H"; "3H"; "4H"; "5H"; "6H"; "7H"; "8H"; "9H"; "10H"],
 ["1D"; "2D"; "3D"; "4D"; "5D"; "6D"; "7D"; "8D"; "9D"; "10D"],
 ["1C"; "2C"; "3C"; "4C"; "5C"; "6C"; "7C"; "8C"; "9C"; "10C"])


3. Queues

type 'a queue = NilQ | ConsQ of 'a * 'a queue;;
type 'a partial = None | Val of 'a;;
 
# let isempty = function 
      NilQ -> true 
    | _ -> false;;
 
val isempty : 'a queue -> bool = <fun>
 
# let peek = function 
        NilQ -> None
      | ConsQ (x,q) -> Val x;;
 
val peek : 'a queue -> 'a partial = <fun>
 
# let dequeue = function 
        NilQ -> failwith "empty queue"
      | ConsQ (x,q) -> q;;
 
val dequeue : 'a queue -> 'a queue = <fun>
 
# let rec enqueue x q = match q with
    NilQ -> ConsQ (x,NilQ)
  | ConsQ(y,q') -> ConsQ(y,enqueue x q');;
 
val enqueue : 'a -> 'a queue -> 'a queue = <fun>


4. Evaluating expressions

type exp =
    Const of int
  | Var of string
  | Sum of exp * exp
  | Sub of exp * exp
  | True
  | False
  | Not of exp
  | Or of exp*exp
  | And of exp*exp;;
 
type result = Bool of bool | Int of int;;
 
# let rec eval e rho = match e with
    Const v -> Int v
  | Var x -> (match applyenv x rho with 
      None -> failwith ("Unbound variable " ^ x)
    | Val v -> v)
  | Sum (e1,e2) -> (match (eval e1 rho, eval e2 rho) with
      (Int v1, Int v2) -> Int (v1+v2)
    | _ -> failwith "Type mismatch")
  | Sub (e1,e2) -> (match (eval e1 rho, eval e2 rho) with
      (Int v1, Int v2) -> Int (v1-v2)
    | _ -> failwith "Type mismatch")
  | True -> Bool true
  | False -> Bool false
  | And (e1,e2) -> (match (eval e1 rho, eval e2 rho) with
      (Bool v1, Bool v2) -> Bool (v1 && v2)
    | _ -> failwith "Type mismatch")
  | Or (e1,e2) -> (match (eval e1 rho, eval e2 rho) with
      (Bool v1, Bool v2) -> Bool (v1 || v2)
    | _ -> failwith "Type mismatch")
  | Not e1 -> (match (eval e1 rho) with
      Bool v1 -> Bool (not v1)
    | _ -> failwith "Type mismatch");;
 
val eval : exp -> (string * result) list -> result = <fun>

Examples:

# let rho0 = [("x",Int 3);("y", Int 5);("z",Bool true)];;
val rho0 : (string * result) list = [("x", Int 3); ("y", Int 5); ("z", Bool true)]
 
# eval (Sum(Sub(Var "x", Const 1),Var "y")) rho0;;
- : result = Int 7
 
# eval (And(Var "z",False)) rho0;;
- : result = Bool false
 
# eval (Sum(Var "x", Var "z")) rho0;;
Exception: Failure "Type mismatch".


5. Simple type checking

# let rec typecheck = function
    Const v -> TInt
  | Sum(e1,e2) -> (match (typecheck e1,typecheck e2) with 
      (TInt,TInt) -> TInt
    | _ -> TErr)
  | True -> TBool
  | False -> TBool
  | Not(e) -> if typecheck e = TBool then TBool else TErr
  | And(e1,e2) -> (match (typecheck e1,typecheck e2) with 
      (TBool,TBool) -> TBool
    | _ -> TErr)
  | Ifthen(e1,e2,e3) -> if typecheck e1 <> TBool then TErr else 
    let t2 = typecheck e2 in 
    if t2 = typecheck e3 then t2 else TErr
;;
 
val typecheck : exp -> t = <fun>
 
# typecheck (Ifthen(And(True,False), Not(And(True,False)), Const 3));;
- : t = TErr
 
# typecheck (Ifthen(And(True,False), Ifthen(Not(And(True,False)), Sum(Const 3,Const 4), Const 0), Const 3));;
- : t = TInt


7. Binary Search Trees

# type 'a bstree = Empty | Node of 'a * 'a bstree * 'a bstree
 
# let rec member x = function 
    Empty -> false
  | Node(y,tl,tr) -> 
	  if x=y then true
	  else if x<y then member x tl
	  else member x tr;;
 
val member : 'a -> 'a bstree -> bool = <fun>
 
# let rec height = function 
    Empty -> 0
  | Node(x,tl,tr) -> 1 + max (height tl) (height tr);;
 
val height : 'a bstree -> int = <fun>
 
# let rec insert x = function
    Empty -> Node(x,Empty,Empty)
  | Node(y,tl,tr) when x=y -> Node(y,tl,tr)
  | Node(y,tl,tr) when x<y -> let tl' = insert x tl in Node(y,tl',tr)
  | Node(y,tl,tr) -> let tr' = insert x tr in Node(y,tl,tr');;
 
val insert : 'a -> 'a bstree -> 'a bstree = <fun>
 
# let rec inorder = function
    Empty -> []
  | Node(x,tl,tr) -> (inorder tl) @ [x] @ (inorder tr);;
 
val inorder : 'a bstree -> 'a list = <fun>
 
# let rec strictly_increasing = function
    [] -> true
  | [x] -> true
  | x::y::l' -> x<y && (strictly_increasing (y::l'));;
 
val strictly_increasing : 'a list -> bool = <fun>
 
# let sanitycheck t = strictly_increasing (inorder t);;
val sanitycheck : 'a bstree -> bool = <fun>
 
# let rec maptree f = function
    Empty -> Empty
  | Node(x,tl,tr) -> Node(f x, maptree f tl, maptree f tr);;
 
val maptree : ('a -> 'b) -> 'a bstree -> 'b bstree = <fun>
ex-types-sol.txt · Last modified: 2015/10/08 15:20 (external edit)