(* EXERCICE 1 *) (*Q 1*) (* type 'a avl = Empty | Node of ('a avl * int * 'a avl * int);; *) (*Q 2*) (* let rec caractoprint a = match a with |Empty -> "" |Node(g,r,d,l) -> (caractoprint g)^(string_of_int r)^(caractoprint d);; let print_avl a = printf "%s" (caractoprint a);; *) (*Q 3*) module type Set = sig type 'a set val empty : 'a set val is_empty : 'a set -> bool val balance : 'a set -> 'a -> 'a set -> 'a set val add : 'a set -> 'a -> 'a set val mem : 'a -> 'a set -> bool val remove : 'a -> 'a set -> 'a set val cardinal : 'a set -> int val union : 'a set -> 'a set -> 'a set val inclus : 'a set -> 'a set -> bool val inter : 'a set -> 'a set -> 'a set val extract : 'a set -> 'a -> 'a*'a set val fold : 'a -> 'b -> 'a -> 'a set -> 'b end;; (*Q 4*) module Avl:Set = struct type 'a avl = Empty | Node of ('a avl * int * 'a avl * int) type 'a set = avl let empty = Empty let is_empty a = match a with |Empty -> true |_ -> false;; let avl_height a = match a with |Empty -> 0 |Node(g,r,d,l) -> l let node g r d = Node(g,r,d,1 + max (avl_height g) (avl_height d)) exception Impossible let balance g r d = let hg = avl_height g and hd = avl_height d in if abs(hg - hd) <= 1 then node g r d else if hg > hd then match g with |Empty -> raise Impossible |Node(fg,rg,fd,_) -> let hgg = avl_height fg and hdg = avl_height fd in if hgg > hdg then node fg rg (node fd r d) else match fd with |Empty -> raise Impossible |Node(fdg,rdg,fdd,_) -> node (node fg rg fdg) rdg (node fdd r d) else match d with |Empty -> raise Impossible |Node(fg,rd,fd,_) -> let hgd = avl_height fg and hdd = avl_height fd in if hgd < hdd then node (node g r fg) rd fd else match fg with |Empty -> raise Impossible |Node(fgg,rgd,fgd,_) -> node (node g r fgg) rgd (node fgd rd fd) let rec add a e = match a with |Empty -> node Empty e Empty |Node(g,r,d,_) -> if e = r then a else if e < r then balance (add g e) r d else balance g r (add d e) let rec mem a e = match a with |Empty -> false |Node(g,r,d,_) -> if r = e then true else (mem g e) || (mem d e) let rec minelt a = match a with |Empty -> raise Impossible |Node(Empty,r,d,_) -> r |Node(g,r,d,_) -> minelt g let rec remminelt a = match a with |Empty -> raise Impossible |Node(Empty,r,d,_) -> d |Node(g,r,d,_) -> balance (remminelt g) r d let fusion a b = match a,b with |Empty,b -> b |a,Empty -> a |a,b -> balance a (minelt b) (remminelt b) let rec remove a e = if not (mem a e) then a else match a with |Empty -> Empty |Node(g,r,d,_) -> if e = r then fusion g d else if e < r then balance (remove g e) r d else balance g r (remove d e) let rec cardinal a = match a with |Empty -> 0 |Node(g,r,d,l) -> 1 + (cardinal g) + (cardinal d) let rec union a b = match a,b with |Empty,_ -> b |a,Empty -> a |a,Node(bg,r,bd,l) -> union (add a r) (remove b r) (*Q 5*) let rec inclus a b = match a,b with |Empty,_ -> false |a,Empty -> true |a,Node(bg,br,bd,l) -> (inclus a bg) && (mem a br) && (inclus a bd) (*Q 6*) let rec inter a b = match a,b with |Empty,_ -> Empty |a,Empty -> Empty |a,Node(bg,br,bd,l) -> let u = union (inter a bg) (inter a bd) in if (mem a br) then (add u br) else u (*Q 7*) let extract a v = (v,remove v a) let rec avltolist a = match a with |Empty -> [] |Node(g,r,d,_) -> (avltolist g)@(r::(avltolist d)) let fold a f e = List.fold_left f e (avltolist a) end;; let test = Node(Node(Node(Empty,1,Empty,1),2,Node(Empty,3,Empty,1),2),4,Node(Node(Empty,5,Empty,1),6,Empty,2),3);;