(*****************************************************************************) (* Illustration du concept de module *) (*****************************************************************************) (* Arbres binaires de recherche *) (* Olivier Ly *) module type ORDERED = sig type t val eq : t -> t -> bool (* ... à compléter ... *) val lt : t -> t -> bool end;; (* 1. Completer le type modulaire précédent ORDERED de telle sorte que la definition du module ABR soit correcte *) module ABR : functor (Key : ORDERED) -> sig type t = Empty | Node of Key.t * t * t val quick_insert : t -> Key.t -> t val search : t -> Key.t -> Key.t option val insert : t -> Key.t -> t val size : t -> int val equilibrate : t -> t val abr2list : t -> Key.t list end = functor (Key : ORDERED) -> struct type t = Empty | Node of Key.t * t * t let rec quick_insert t x = match t with | Empty -> Node (x, Empty, Empty) | Node (v, fg, fd) -> if (Key.lt x v) then Node (v, (quick_insert fg x), fd) else Node (v, fg, (quick_insert fd x)) let rec search t x = match t with | Empty -> None | Node (v, fg, fd) -> if Key.eq x v then Some v else if Key.lt x v then search fg x else search fd x (** balanced trees *) let rotate_right t = match t with | Empty -> Empty | Node (_, Empty ,_) -> t | Node (v, (Node (v',fg',fd')), fd) -> (Node (v',fg',(Node (v, fd',fd)))) let rotate_left t = match t with | Empty -> Empty | Node (_, _ ,Empty) -> t | Node (v, fg, (Node (v',fg',fd'))) -> (Node (v',(Node (v, fg, fg')),fd')) let rec height = function | Empty -> 0 | Node (_, fg, fd) -> 1 + (max (height fd) (height fg)) let rec insert t x = match t with | Empty -> Node (x, Empty, Empty) | Node (v, fg, fd) -> if x=v then t else if x < v then let fg' = (insert fg x) in match fg' with | Empty | Node (_,Empty,Empty) -> Node (v, fg', fd) | Node (_,fg'',fd'') -> if (height fg') <= (height fd) + 1 then Node (v, fg', fd) else if (height fg'') < (height fd'') then (rotate_right (Node (v, (rotate_left fg'), fd))) else (rotate_right (Node (v, fg',fd))) else let fd' = (insert fd x) in match fd' with | Empty | Node (_,Empty,Empty) -> Node (v, fg, fd') | Node (_,fg'',fd'') -> if (height fd') <= (height fg) + 1 then Node (v, fg, fd') else if (height fd'') < (height fg'') then (rotate_left (Node (v, fg, (rotate_right fd')))) else (rotate_left (Node (v, fg, fd'))) let rec size t = match t with | Empty -> 0 | Node (v,fg,fd) -> 1 + (size fg) + (size fd) (* mutually recursive *) let rec shift_right t = match t with | Empty | Node (_,Empty,_) -> t | Node (v,(Node (v',fg',Empty)),fd) -> (Node (v',fg',(Node (v,Empty,fd)))) | Node (v,fg,fd) -> (shift_right (Node (v, (shift_left fg), fd))) and shift_left t = match t with | Empty | Node (_,_,Empty) -> t | Node (v,fg,(Node (v',Empty,fd'))) -> (Node (v',(Node (v,fg,Empty)),fd')) | Node (v,fg,fd) -> (shift_left (Node (v, fg, (shift_right fd)))) (* TODO: transformer le programme pour eviter de recalculer la taille *) let rec equilibrate t = match t with | Empty -> Empty | Node (v,fg,fd) -> let fgs, fds = (size fg, size fd) in if fgs > fds + 1 then (equilibrate (shift_right t)) else if fds > fgs + 1 then (equilibrate (shift_left t)) else Node (v, (equilibrate fg), (equilibrate fd)) let rec abr2list = function | Empty -> [] | Node (v, fg, fd) -> (abr2list fg) @ [v] @ (abr2list fd) end;; (** Instanciation du module ORDERED *) module INT = struct type t = int let eq x y = x=y let lt x y = x < y let of_int (x:int) : t = x end;; (** Instanciation de ABR *) module IntAbr = ABR(INT);; (** 2. Ajouter une fonction de suppression au module ABR *) (*****************************************************************************) (* test *) (*****************************************************************************) let t = List.fold_left (fun t x -> IntAbr.insert t x) IntAbr.Empty [1;3;2;10;4;6;5];; let t' = List.fold_left (fun t x -> IntAbr.quick_insert t x) IntAbr.Empty [1;2;3;4;5;6;7;8;9;10;11];; let et = IntAbr.equilibrate t';; IntAbr.abr2list et;; (** 3. la fonction size n'est pas implémentée correctement. Corriger le code ! *) IntAbr.abr2list t;; IntAbr.search t 6;; IntAbr.search t 11;; (*****************************************************************************) (*****************************************************************************)