Voir la source de Avl.ml

== Implementation des AVL ==

Ce module présente une implantation classique des AVL qui suit la représentation du cours d'algo. La seule particularité est l'utilisation d'une fonction (de première classe) permettant ''d'enregistrer'' les appels aux transformations d'arbres (rotation.)

<pre>
(* AVL *)

(* Les clefs sont des entiers *)
type t =
    Empty
  | Node of int * t * int * t

(* L'arbre vide et le test du vide *)
let empty = Empty
let is_empty t = t = Empty

(* recherche d'une clef *)
let rec mem k = function
    Empty -> false
  | Node(k',_,_,_) when k=k' -> true
  | Node(k',s,_,_) when k<k' -> mem k s
  | Node(_,_,_,s) -> mem k s

(* Affichage "classique" sur la sortie standard *)
let rec print = function
    Empty -> Format.printf "()"
  | Node(k,fg,d,fd) ->
      begin
	Format.printf "@,(@[<b>%i," k;
	print fg;
	Format.printf ",%i," d;
	print fd;
	Format.printf "@])"
      end

(* Affichage de l'arbre pour tikz *)
let rec print_tikz = function
    Empty -> Format.printf "child {node {\ }}@,"
  | Node(k,fg,d,fd) ->
      begin
	Format.printf "child {@[<v>node {%i,%i}@," k d;
	print_tikz fg;
	print_tikz fd;
	Format.printf "@]}@,";
      end

(* Affichage d'un arbre en LaTeX (avec tikz) à insérer dans un fichier .tex *)
let print_tex t =
  begin
    Format.printf "\\begin{center}\\begin{tikzpicture}";
    Format.printf "[every node/.style={draw=black,circle}]@.";
    begin
      match t with
	  Empty -> Format.printf "\\node {\ };@."
	| Node(k,fg,d,fd) ->
	    begin
	      Format.printf "\\node@[<v> {%i,%i}
  [level/.style={level distance={max(8mm,30mm-(5mm*#1))},sibling distance=260mm/(2^#1)}] @," k d;
	      print_tikz fg;
	      print_tikz fd;
	      Format.printf "@];@.";
	    end
    end;
    Format.printf "\\end{tikzpicture}\\end{center}@."
  end

(* Les rotations *)

(* rotation droite *)
let rd update = function
    Node(k,Node(kg,fgg,deseqg,fgd),deseq,fd) ->
      begin
	ignore(update "rd");
	Node(kg,fgg,deseqg-1,Node(k,fgd,1-deseqg,fd))
      end
  | _ -> assert false

(* rotation gauche *)
let rg update = function
    Node(k,fg,deseq,Node(kd,fdg,deseqd,fdd)) ->
      begin
	ignore(update "rg");
	Node(kd,Node(k,fg,-1-deseqd,fdg),1+deseqd,fdd)
      end
  | _ -> assert false

(* rotation gauche-droite *)
let rgd update = function
    Node(k,Node(kg,fgg,dg,Node(kgd,fgdg,dgd,fgdd)),d,fd) ->
      begin
	let dg' =
	  if dgd = -1 then 1 else 0
	in
	let d' =
	  if dgd = 1 then (-1) else 0
	in
	ignore(update "rgd");
	Node(kgd,Node(kg,fgg,dg',fgdg),0,Node(k,fgdd,d',fd))
      end
  | t ->
      begin
	print t; Format.printf "@.";
	assert false
      end

(* rotation droite-gauche *)
let rdg update = function
    Node(k,fg,d,Node(kd,Node(kdg,fdgg,ddg,fdgd),dd,fdd)) ->
      begin
	let dd' =
	  if ddg = 1 then (-1) else 0
	in
	let d' =
	  if ddg = -1 then 1 else 0
	in
	ignore(update "rdg");
	Node(kdg,Node(k,fg,d',fdgg),0,Node(kd,fdgd,dd',fdd))
      end
  | t ->
      begin
	print t; Format.printf "@.";
	assert false
      end

(* Insertion dans un AVL (fonction récursive) *)
let rec insert update k = function
    Empty -> (1,Node(k,Empty,0,Empty))
  | Node(k',fg,d,fd) as n when k=k' -> (0,n)
  | Node(k',fg,d,fd) when k<k' ->
      begin
	match insert update k fg with
	    (0,nfg) -> (0,Node(k',nfg,d,fd))
	  | (_,Node(kg,fgg,dg,fgd)) ->
		let (nd,n) =
		  let n' = Node(k',Node(kg,fgg,dg,fgd),d+1,fd) in
		    if d = 1 then
		      if dg = 1 then
			match rd update n' with
			    Node(_,_,nd,_) as n -> (nd,n)
			  | _ -> assert false
		      else
			match rgd update n' with
			    Node(_,_,nd,_) as n -> (nd,n)
			  | _ -> assert false
		    else
		      (d+1,n')
		in
		  (nd,n)
	  | _ -> assert false
      end
  | Node(k',fg,d,fd) ->
      begin
	match insert update k fd with
	    (0,nfd) -> (0,Node(k',fg,d,nfd))
	  | (_,Node(kd,fdg,dd,fdd)) ->
		let (nd,n) =
		  let n' = Node(k',fg,d-1,Node(kd,fdg,dd,fdd)) in
		    if d = -1 then
		      if dd = -1 then
			match rg update n' with
			    Node(_,_,nd,_) as n -> (nd,n)
			  | _ -> assert false
		      else
			match rdg update n' with
			    Node(_,_,nd,_) as n -> (nd,n)
			  | _ -> assert false
		    else
		      (d-1,n')
		in
		  (nd,n)
	  | _ -> assert false
      end

(* Insertion dans un AVL (fonction d'appel) *)
let add update k t =
  match insert update k t with
      (_,nt) -> nt
</pre>

Cette implantation suit les algos du TD. L'affichage "LaTeX" propose une sortie en tikz/pgf (version 2) qu'il faut insérer dans un fichier LaTeX adéquat. Dans l'ensemble des fonctions précédantes, la fonction (en paramètre) <tt>update</tt> sert à ''enregistrer'' les rotations, vous pourrez voir un exemple d'utilisation dans [[test-arbre.ml]].