-- Date : Mars 2015
-- Auteur : MJ. Huguet
-- 
-- Objet : corps paquetage arbre binaire de recherche generique
--
-- Fait 
-- 
-----------------------------------------------------------------------------
with Unchecked_Deallocation;
with Ada.Text_IO; use Ada.Text_IO;

package body Arbre_Bin_Recherche_Cle_G is
   
   -----------------------------------------------------------------------------
   procedure Free_Noeud IS NEW Unchecked_Deallocation(Noeud, LienArbre);
   
   procedure Liberer_Lien(LA : in out LienArbre) is
   begin
      if LA /= null then
         Liberer_Lien(LA.all.gauche); -- desallocation partie gauche
         Liberer_Lien(LA.all.droite); -- desallocation partie droite
         Liberer_Element(LA.All.Info);   -- desallocation contenu du noeud racine
         Free_Noeud(LA);              -- desallocation noeud racine
      end if;
   end Liberer_Lien;
   
   procedure Liberer(A : in out Arbre) is
   begin
      Liberer_Lien(A.Debut);
      A.Debut := null;
      A.Taille := 0;
   end Liberer;
   -----------------------------------------------------------------------------
   
   function ">"(K1, K2 : Key) return Boolean is begin
      return K2 < K1; end ">";
   
   -----------------------------------------------------------------------------
   function Est_Vide(A : in Arbre) return Boolean is
   begin
      return A.Debut=null;
   end Est_Vide;
   -----------------------------------------------------------------------------
   -----------------------------------------------------------------------------
   function Taille(A : in Arbre) return Natural is
   begin
      return A.Taille;
   end Taille;
   -----------------------------------------------------------------------------
   -----------------------------------------------------------------------------
   function Racine(A: in Arbre) return Element is
   begin
      if Est_Vide(A) then
	 raise Arbre_Vide;
      else
	 return A.Debut.all.Info;
      end if;
   end Racine;
   -----------------------------------------------------------------------------
   
   -----------------------------------------------------------------------------
   function Appartient_Lien(E : in Element; LA : in LienArbre) return Boolean is
      -- Fait
   begin
      if LA = null then
	 return False;
      elsif Cle_de(LA.Info) > Cle_de(E) then
	 return Appartient_Lien(E, LA.Gauche);
      elsif Cle_de(LA.Info) < Cle_De(E) then
	 return Appartient_Lien(E, LA.Droite);
      else 
	 return TRUE;
      end if;
   end Appartient_Lien;
   
   function Appartient(E : in Element; A : in Arbre) return Boolean is
   begin
      return Appartient_Lien(E, A.Debut);
   end Appartient;
   -----------------------------------------------------------------------------
   
   -----------------------------------------------------------------------------
   function Lien_To_String(LA : in LienArbre) return String is
      -- Fait
   begin
      if LA /= null then
	 return Lien_To_String(LA.Gauche) & Element_To_String(LA.Info) & Lien_To_String(LA.Droite);
      else return "";
      end if;
   end Lien_To_String;

   function Arbre_To_String(A : in Arbre) return String is
   begin
      return "(" & Integer'Image(A.Taille) & "|" & Lien_To_String(A.Debut) & ")";
   end Arbre_To_String;
   -----------------------------------------------------------------------------
   
   -----------------------------------------------------------------------------
   -- Fait en version itérative comme demandé, moins efficace que la version récursive 
   procedure Inserer_Lien(E : in Element; LA : in out LienArbre) is
      -- Fait
      P, Prec : LienArbre := LA;
   begin
      if LA = null then                       -- Si l'arbre est vide, on ajoute un premier noeud
	 LA := new Noeud'(E, null, null);
      else                                    -- Sinon on parcourt l'arbre en fonction de la valeur
	 while P /= null loop                 -- de E jusqu'à une case où l'on peut l'ajouter
	    if Cle_De(E) > Cle_De(P.Info) then
	       Prec := P;                     -- On mémorise la valeur du précédant à P également
	       P := P.all.Droite;
	    elsif Cle_De(E) < Cle_De(P.Info) then
	       Prec := P;
	       P := P.all.Gauche;
	    else
	       raise Element_Deja_Present;
	    end if;
	 end loop;
	 
	 if Prec.Gauche = null and then Cle_De(Prec.Info) > Cle_De(E) then
	    Prec.Gauche := new Noeud'(E, null, null);
	 elsif Prec.Droite = null and then Cle_De(Prec.Info) < Cle_De(E) then
	    Prec.Droite := new Noeud'(E, null, null);
	 else
	    raise Program_Error;
	 end if;
      end if;
   end Inserer_Lien;
   
   procedure Inserer(E : Element; A : in out Arbre) is
   begin
      Inserer_Lien(E, A.Debut);
      A.Taille := A.Taille + 1;
   end Inserer;
   -----------------------------------------------------------------------------
   
   -----------------------------------------------------------------------------   
   procedure Supprimer_Maxg(LA : in out LienArbre; Maxg : out Element) is
      -- Fait
      Buffer : LienArbre;
   begin
      if LA.Droite = null then
	 Maxg := LA.Info;
	 
	 Buffer := LA.Gauche;                    -- Ces "tas" d'instructions (plusieurs arrivent
	 LA.info := LA.Gauche.info;              -- ensuite) sont dû au fait qu'implémenter une
	 LA.Droite := LA.Gauche.Droite;          -- fonction de copie valables dans tous les cas
	 LA.Gauche := LA.Gauche.Gauche;          -- serait ajouter une compléxité non nécéssaire
	 
	 Liberer_Element(Buffer.Info);
	 Free_Noeud(Buffer);
      else
	 Supprimer_Maxg(LA.Droite, Maxg);
      end if;
   end Supprimer_Maxg;
   
   procedure Supprimer_Lien(E : in Element; LA : in out LienArbre ) is
      -- Fait (cf. page 41 poly)
      Maxg : Element;
      Buffer : LienArbre;
   begin
      if LA = null then raise Element_Non_Present;
      elsif Cle_De(E) > Cle_De(LA.Info) then                 -- On cherche le lien supprimer
	 Supprimer_Lien(E, LA.all.Droite);                   -- en récursif
      elsif Cle_De(E) < Cle_De(LA.Info) then
	 Supprimer_Lien(E, LA.all.Gauche);
      else -- i.e. E = LA.info
	 if LA.Droite = null and LA.Gauche = null then
	    Maxg := LA.Info;
	    Liberer_Lien(LA);
	    LA := null;
	 elsif LA.Droite = null then                         -- Pour des raisons techniques, il est
	    Buffer := LA.Gauche;                             -- préférable de "vampiriser" le noeud
	    LA.info := LA.Gauche.info;                       -- fils
	    LA.Droite := LA.Gauche.Droite;
	    LA.Gauche := LA.Gauche.Gauche;
	    
	    Liberer_Element(Buffer.Info);
	    Free_Noeud(Buffer);
	 elsif LA.Gauche = null then                         -- Idem
	    Buffer := LA.Droite;
	    LA.Info := LA.Droite.Info;
	    LA.Gauche := LA.Droite.Gauche;
	    LA.Droite := LA.Droite.Droite;
	    
	    Liberer_Element(Buffer.Info);
	    Free_Noeud(Buffer);
	 else                                                -- Ou on le remplace par une valeur 
	    Supprimer_Maxg(LA.Gauche, Maxg);
	    LA.Info := Maxg;
	 end if;
      end if;
   end Supprimer_Lien;
   
   
   procedure Supprimer(E : in Element; A : in out Arbre) is
   begin
      Supprimer_Lien(E, A.Debut);
      A.Taille := A.Taille - 1;
   end Supprimer;
   -----------------------------------------------------------------------------
   
   
   -----------------------------------------------------------------------------
   function Recherche_Lien(C: in Key; LA : in LienArbre) return Element is
   begin
      if LA = null then raise Element_Non_Present;
      elsif Cle_De(LA.Info) > C then
	 return Recherche_Lien(C, LA.Gauche);
      elsif Cle_De(LA.Info) < C then
	   return Recherche_Lien(C, LA.Droite);
      else
	 return LA.Info;
      end if;
   end Recherche_Lien;
   
   function Rechercher_Par_Cle(C: in Key; A : in Arbre) return Element is
   begin
      return Recherche_Lien(C, A.Debut);
   end Rechercher_Par_Cle;
   -----------------------------------------------------------------------------
   
   
   -----------------------------------------------------------------------------
   function MinL(L: in LienArbre) return Element is
   begin
      if L.Gauche /= null then
	 return MinL(L.Gauche);
      elsif L.Gauche = null and then L.Droite /= null then
	 return MinL(L.Droite);
      else
	 return L.Info;
      end if;
   end MinL;
   
   function Min(A : in Arbre) return Element is
   begin
      return MinL(A.Debut);
   end Min;
   -----------------------------------------------------------------------------
   
   
   -----------------------------------------------------------------------------
   function MaxL(L: in LienArbre) return Element is
   begin
      if L = null then Put_Line("DEBUG"); end if;
      if L.all.Droite /= null then
	 return MaxL(L.Droite);
      else
	 return L.Info;
      end if;
   end MaxL;
   
   function MaxA(A : in Arbre) return Element is
   begin
      return MaxL(A.Debut);
   end MaxA;
end Arbre_Bin_Recherche_Cle_G;



