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
| 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>

- : 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 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>```