Below are the commands demonstrated during the lecture session (plus some additional commands).
Remember:
Try them yourself.
Tweak them: modify them and try variants of those commands.
Your curiosity is your best pedagogical tool.
Disclaimer: the functions in the code below are defined most of the times without SPECIFICATION. Remember that defining a function always consists in giving its specification and then implementation.
type binary_tree =
| Empty
| Node of int * binary_tree * binary_tree ;;
let bt1 =
Node (100,
Node (30,Empty,Empty),
Node (74,Empty,Empty)
) ;;
let bt2 =
Node(
100,
Node(30,
Node(70,Empty,Empty),
Node(12,Empty,Empty)
),
Node(74,
Node(8,Empty,Empty),
Node(7,Empty,Empty)
)
);;
(* Some functions on binary trees of integers *)
let rec depth (t:binary_tree):int=
match t with
Empty -> 0
| Node (_, t1, t2) -> 1+ max (depth t1) (depth t2) ;;
depth bt1;;
depth bt2;;
let rec sum (t:binary_tree):int=
match t with
Empty -> 0
| Node (l,t1,t2) -> l + sum t1 + sum t2 ;;
sum bt1 ;;
sum bt2 ;;
let rec maximum (t:binary_tree):int =
match t with
Node (l, Empty,Empty) -> l
| Node (l, Empty, t1) | Node (l, t1, Empty) -> max l (maximum t1)
| Node (l, t1, t2) -> let m1 = maximum t1 and m2 = maximum t2 in max l (max m1 m2)
| Empty -> failwith "maximum should not be called on an empty tree" ;;
maximum bt1 ;;
maximum bt2 ;;
let rec sum_leaves (t:binary_tree):int=
match t with
| Empty -> 0
| Node (e,Empty,Empty) -> e
| Node (_, Empty,tprime) | Node (_,tprime,Empty) -> sum_leaves tprime
| Node (_,tl,tr) -> sum_leaves tl + sum_leaves tr ;;
sum_leaves bt1 ;;
sum_leaves bt2 ;;
type 'a bintree = Empty | Node of 'a * 'a bintree * 'a bintree ;;
(* We can redefine the previous trees with the new type *)
let bt1 =
Node (100,
Node (30,Empty,Empty),
Node (74,Empty,Empty)
);;
let bt2 =
Node(
100,
Node(30,
Node(70,Empty,Empty),
Node(12,Empty,Empty)
),
Node(74,
Node(8,Empty,Empty),
Node(7,Empty,Empty)
)
);;
(* but also define others using other types *)
let bt3 =
Node(
'a',
Node('b',
Node('b',Empty,Empty),
Node('k',Empty,Empty)
),
Node('t',
Node('p',Empty,Empty),
Node('n',Empty,Empty)
)
);;
let bt' =
Node(
"president",
Node("vice president research",
Node("consellor1",Empty,Empty),
Node("consellor3",Empty,Empty)
),
Node("vice president formation",
Node("consellor4",Empty,Empty),
Node("consellor8",Empty,Empty)
)
);;
(* Some functions on polymorphic binary trees *)
let rec belongsto (elt:'a) (t:'a bintree):bool =
match t with
| Empty -> false
| Node (e,tl,tr) -> (e=elt)|| belongsto elt tl || belongsto elt tr ;;
belongsto 30 bt1;;
belongsto 20 bt1;;
let rec labels (t:'a bintree):'a list=
match t with
| Empty -> []
| Node (elt,tl,tr) -> (labels tl)@(elt::(labels tr));;
labels bt1;;
let rec size (t:'a bintree):int=
match t with
| Empty -> 0
| Node (_,l,r) -> 1+ size l + size r ;;
size bt1;;
let rec leaves (t:'a bintree):'a list=
match t with
| Empty -> []
| Node (elt,Empty,Empty) -> [elt]
| Node (_,tl,tr) -> (leaves tl)@(leaves tr);;
leaves bt1;;
leaves bt2;;
let rec maptree (t:'a bintree) (f:'a -> 'b):'b bintree=
match t with
Empty -> Empty
| Node (elt,tl,tr) -> Node (f elt,maptree tl f,maptree tr f);;
maptree bt1 (fun x -> Char.chr x) ;;
let rec mirror (t:'a bintree):'a bintree=
match t with
| Empty -> Empty
| Node (e, lt,rt) -> Node (e,mirror rt,mirror lt);;
(* Iterators on binary trees *)
let rec fold_lrr (f:'a -> 'b -> 'b -> 'b) (acc:'b) (t:'a bintree):'b=
match t with
Empty -> acc
| Node (elt, l, r) ->
let rl = fold_lrr f acc l
and rr = fold_lrr f acc r in
f elt rl rr ;;
let size2 = fold_lrr (fun _ l r -> 1 + l + r) 0 ;;
size2 bt1;;
let depth2 = fold_lrr (fun _ l r -> 1 + max l r) 0;;
depth2 bt1;;
let mirror2 = fold_lrr (fun e l r -> Node(e,r,l)) Empty;;
mirror2 bt1;;
(* Pathes in a binary tree*)
type 'elt bt = Et | BT of 'elt bt * 'elt * 'elt bt ;;
let rec add_to_each = function
| (n,[]) -> []
| (n,c::cs) -> (n::c) :: (add_to_each (n,cs)) ;;
let rec paths = function
| Et -> [ [] ]
| BT(Et,n,Et) -> [ [n] ]
| BT(l,n,r) -> add_to_each(n, (paths l) @ (paths r)) ;;
let bt3 =
BT (
BT (BT(Et,4,Et),30,Et),
100,
BT (Et,74,BT(Et,98,Et))
);;
paths bt3;;
type 'a bst = E | N of 'a * 'a bst * 'a bst;;
let rec belongsto (elt:'a) (t:'a bst):bool=
match t with
| E -> false
| N (e, lbst,rbst) -> (e=elt) || (e>elt) && belongsto elt lbst || (e<elt) && belongsto elt rbst;;
let bst1=
N (10,
N (5,
N (3, E, E),
N (9, E, E)
),
N (30,
E,
N (70,E,E)
)
);;
let rec tolistinorder (t: 'a bst):'a list=
match t with
E -> []
| N (elt, lbst, rbst) -> (tolistinorder lbst)@(elt::tolistinorder rbst);;
tolistinorder bst1;;
(* Insertion with integers *)
let rec insert (elt:'a) (t:'a bst):'a bst=
match t with
| E -> N (elt,E,E)
| N (e,lbst,rbst) when elt < e -> N (e,insert elt lbst, rbst)
| N (e,lbst,rbst) (* when elt >= e *) -> N (e,lbst, insert elt rbst);;
insert 38 bst1;;
let rec create_bst (l:'a list):'a bst=
match l with
[] -> E
| elt::remainder -> insert elt (create_bst remainder);;
let bst2 = create_bst [1;4;76;37;28;54;84;57;53;487];;
(* Insert as a root *)
let rec cut (t:'a bst) (elt:'a):('a bst*'a bst)=
match t with
E -> E,E
| N(x,l,r) when x=elt -> l,r
| N(x,l,r) when x < elt ->
let crsmaller,crbigger = cut r elt in N(x,l,crsmaller),crbigger
| N(x,l,r) ->
let crsmaller,crbigger = cut l elt in crsmaller, N(x,crbigger,r);;
let insert_root (elt:'a) (t:'a bst):'a bst =
let tl,tr = cut t elt in N(elt,tl,tr);;
let bst3 = N(10,N(5,N(2,E,E),N(7,E,E)),N(30,E,N(70,E,E)));;
insert_root 9 bst3;;
insert_root 24 (insert_root 9 bst3);;
(* Suppression in a BST *)
let rec suppress_max (t:'a bst):'a*'a bst=
match t with
| E -> failwith "suppress_max"
| N (x,lt,E) -> (x,lt)
| N (x,lt,rt) -> let m,rt2 = suppress_max rt in (m,N(x,lt,rt2));;
let rec suppression (t:'a bst) (elt:'a): 'a bst=
match t with
E -> E
| N (x,lt,rt) when x = elt && lt=E -> rt
| N (x,lt,rt) when x = elt -> let (m,lt2) = suppress_max lt in N(m, lt2,rt)
| N (x,lt,rt) when x > elt -> N(x,suppression lt elt,rt)
| N (x,lt,rt) (* x<=elt *) -> N(x,lt, suppression rt elt);;
let path (t:'a bst) (e:'a):'a list=
let rec path_rec (t:'a bst) (e:'a):'a list =
match t with
E -> []
| N (elt, lst, rst) -> elt::(if e=elt then [] else if e<elt then path_rec lst e else path_rec rst e)
in
if (belongsto e t) then path_rec t e else [] ;;
path bst2 53;;
bst2;;
(*
let abs (n:int):int=
if n<0 then -n else n
;;
let rec depth (t:'a bst):int=
match t with
E -> 0
| N (_, t1, t2) -> 1+ max (depth t1) (depth t2)
;;
let delta (t1:'a bst) (t2:'a bst):int=
let d1 = depth t1 and d2 = depth t2 in
abs (d1 - d2)
;;
let rec balanced (t:'a bst):boolean=
match t with
| E -> true
| Node (_,lbst,rbst) -> (delta lbst rbst)<2 && balanced lbst && balanced rbst
;;
let rotateRight (t:'a bst):'a bst=
match t with
N (a, N(b,bl,br), ar) -> N (b,bl,N (a,br,ar))
| tree -> tree
;;
let rotateLeft (t:'a bst):'a bst=
match t with
N (b,bl,N (a,br,ar)) -> N (a, N(b,bl,br), ar)
| tree -> tree
;;
*)