(* ################################## Algorithmes de base sur les arbres ################################## Remarque de programmation: Cette correction présente une implémentation des arbres à l'aide de pointeurs. Pour retrouver des algorithmes dans l'esprit de Caml (comme en cours), les champs d'un objet de type node_type ne sont pas mutables; ainsi, à chaque étape des algorithmes, on construit un nouvel arbre à partir de l'ancien. *) type 'a node_type = { mutable gauche : 'a abr ; mutable droit : 'a abr ; mutable cle : int ; mutable objet : 'a } and 'a abr = Nil | Noeud of 'a node_type ;; let est_vide arb = ( arb = Nil );; let rec rechercher arb cle = match arb with | Nil -> false | Noeud b -> let c = b.cle in if cle = c then true else if cle < c then rechercher b.gauche cle else rechercher b.droit cle ;; let rec inserer arb cle obj = match arb with | Nil -> Noeud { gauche = Nil ; droit = Nil ; cle = cle ; objet = obj } | Noeud b -> let c = b.cle in if cle = c then failwith "cle déjà présente" else if cle < c then ( b.gauche <- inserer b.gauche cle obj ; Noeud b ) else ( b.droit <- inserer b.droit cle obj ; Noeud b ) ;; let rec liste_to_objets = function | [] -> [] | t::q -> (t,0)::(liste_to_objets q) ;; let rec multiInserer arb = function | [] -> arb | (a,b)::q -> let arb2 = inserer arb a b in multiInserer arb2 q ;; let ex = multiInserer Nil (liste_to_objets [7;4;5;2;1;3;6;10;8;9;12;11]);; let rec maximum arb = match arb with | Nil -> failwith "arbre vide" | Noeud b -> let bd = b.droit in match bd with | Nil -> (b.cle,b.objet) | _ -> maximum bd ;; let precedent arb clef = let rec auxprec a cle gauche cleg = match a with | Nil -> failwith "cle absente" | Noeud b -> let c = b.cle in if cle = c then let bg = b.gauche in match bg with | Nil -> if gauche then failwith "la cle est minimale" else cleg | _ -> fst(maximum bg) else if cle < c then auxprec b.gauche cle gauche cleg else auxprec b.droit cle false c in auxprec arb clef true 0 ;; let rec supprimer arb cle = match arb with | Nil -> failwith "cle absente" | Noeud b -> let c = b.cle in if cle < c then ( b.gauche <- supprimer b.gauche cle ; Noeud b ) else if cle > c then ( b.droit <- supprimer b.droit cle ; Noeud b ) else if est_vide b.droit then b.gauche else if est_vide b.gauche then b.droit else let (m,ob) = maximum b.gauche in ( b.gauche <- supprimer b.gauche m; b.cle <- m; b.objet <- ob; Noeud b ) ;; (* ############# Arbres Splays ############# *) (* Question 1: les fonctions de rotation *) let zigDroit arb = match arb with | Nil -> failwith "opération impossible" | Noeud u -> match u.gauche with | Nil -> failwith "opération impossible" | Noeud v -> u.gauche <- v.droit; v.droit <- Noeud u; Noeud v ;; let zigGauche arb = match arb with | Nil -> failwith "opération impossible" | Noeud v -> match v.droit with | Nil -> failwith "opération impossible" | Noeud u -> v.droit <- u.gauche; u.gauche <- Noeud v; Noeud u ;; let zigzigDroit arb = zigDroit ( zigDroit arb );; let zigzigGauche arb = zigGauche ( zigGauche arb );; let zigzagDroit arb = match arb with | Nil -> failwith "opération impossible" | Noeud t -> t.droit <- zigDroit t.droit; zigGauche (Noeud t);; let zigzagGauche arb = match arb with | Nil -> failwith "opération impossible" | Noeud t -> t.gauche <- zigGauche t.gauche; zigDroit (Noeud t);; (* Question 2: l'algorithme de requête Il s'agit dans un premier temps d'accéder au noeud N étiqueté par la requête en retournant le chemin qui a permis d'y accéder ---> fonction "descente" Ce chemin est une liste de couple de la forme (Noeud n,b) avec b vrai ssi on accède au fils gauche de n au cours de la descente. Ensuite, on remonte le noeud courant (N initialement) à la racine à l'aide des opérations zig et zag ---> fonction "remontee" La fonction générale est écrite dans "requeteSplay" *) let rec descente arb cle chemin prof = match arb with | Nil -> ([],prof) | Noeud b -> let c = b.cle in if cle = c then ((Noeud b,true)::chemin,prof) else if cle < c then descente b.gauche cle ( (Noeud b,true)::chemin ) (prof+1) else descente b.droit cle ( (Noeud b,false)::chemin ) (prof+1) ;; let rec remontee noe = function | [] -> noe | [(Noeud n,b)] -> if b then ( n.gauche <- noe; zigDroit (Noeud n) ) else ( n.droit <- noe; zigGauche (Noeud n) ) | (Noeud u,b1)::(t,b2)::q -> begin match (b1,b2) with | (true,true) -> u.gauche <- noe; remontee (zigzigDroit t) q | (true,false) -> u.gauche <- noe; remontee (zigzagDroit t) q | (false,true) -> u.droit <- noe; remontee (zigzagGauche t) q | (false,false) -> u.droit <- noe; remontee (zigzigGauche t) q end | _ -> failwith "cas impossible" ;; let requeteSplay arb cle = let (chemin,prof) = descente arb cle [] 0 in match chemin with | [] -> (false,arb) (* la clé est absente de l'arbre *) | t::q -> (true, remontee (fst(t)) q) ;; (* Évaluation de la complexité amortie: On construit un arbre peigne de taille n, étiqueté par les entiers compris entre 0 et n-1, et on effectue un grand nombre de requêtes sur cet arbre en mémorisant la profondeur du noeud réalisant la requête, puis on moyenne ces profondeurs par le nombre de requêtes --> on peut se faire une idée de la complexité amortie de l'opération de requête sur les arbres splays *) let requeteSplay2 arb cle = let (chemin,prof) = descente arb cle [] 0 in match chemin with | [] -> (arb,prof) | t::q -> (remontee (fst(t)) q,prof) ;; (* prof désigne la profondeur du noeud étiqueté par la requête *) let rec premiers l = function | 0 -> l | n -> premiers (n::l) (n-1);; let rec multiRequeteSplay ini res arbre = function | 0 -> (List.fold_left (fun a -> fun b -> a+b) 0 res)/ini | n -> let (a,b) = requeteSplay2 arbre ( (Random.int (ini-1))+1 ) in multiRequeteSplay ini (b::res) a (n-1);; let test n = let exemple = multiInserer Nil (liste_to_objets (premiers [] n)) in Random.self_init (); multiRequeteSplay n [] exemple n;; (* # test 100;; - : int = 7 # test 1000;; - : int = 12 # test 10000;; - : int = 17 On observe expérimentalement une complexité amortie logarithmique de la fonction de requête pour les arbres splays alors qu'elle est linéaire pour les arbres de la première partie. *)