User Tools

Site Tools


ex-types-sol

Differences

This shows you the differences between two versions of the page.

Link to this comparison view

ex-types-sol [2015/10/08 15:20] (current)
Line 1: Line 1:
 +====== LiP assignment #5: solutions ======
 +
 +===== 1. Rational numbers =====
 +
 +<code ocaml>
 +# 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
 +</​code>​
 +
 +\\
 +
 +===== 2. Card game =====
 +
 +<code ocaml>
 +# 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"​])
 +</​code>​
 +
 +\\
 +
 +===== 3. Queues =====
 +
 +<code ocaml>
 +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>
 +</​code>​
 +
 +\\
 +
 +===== 4. Evaluating expressions =====
 +
 +<code ocaml>
 +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>
 +</​code>​
 +
 +Examples:
 +<code ocaml>
 +# 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"​.
 +</​code>​
 +
 +\\
 +
 +
 +===== 5. Simple type checking =====
 +
 +<code ocaml>
 +# 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
 +</​code>​
 +
 +\\
 +
 +
 +===== 7. Binary Search Trees =====
 +
 +<code ocaml>
 +# 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>
 +</​code>​
  
ex-types-sol.txt ยท Last modified: 2015/10/08 15:20 (external edit)