130 lines
3.6 KiB
Ada
130 lines
3.6 KiB
Ada
with Ada.Text_Io; use Ada.Text_Io;
|
|
with Unchecked_Deallocation;
|
|
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
|
|
|
package body Tas_Gen is
|
|
|
|
--procedure Free_Noeud IS NEW Unchecked_Deallocation(Un_Tas, Tab_Elements);
|
|
|
|
function ">"(C1, C2 : in Key) return Boolean is begin
|
|
return C2 < C1; end ">";
|
|
|
|
-- Vider le tas
|
|
procedure Liberer(T : in out Un_Tas) is
|
|
begin
|
|
for I in T.Les_Elements'Range loop
|
|
Liberer_Element(T.Les_Elements(I));
|
|
end loop;
|
|
T.Cardinal := 0;
|
|
end Liberer;
|
|
|
|
-- Retourne le nb courant d'éléments du tas
|
|
function Cardinal(T : in Un_Tas) return Natural is
|
|
begin
|
|
return T.Cardinal;
|
|
end Cardinal;
|
|
|
|
-- Fonction interne, place correctement un element en descendant
|
|
procedure Move_Down(E : in Natural; T : in out Un_Tas) is
|
|
P, Fils_Max : Natural := E;
|
|
N : Natural := T.Cardinal;
|
|
Fini : Boolean := False;
|
|
Aux : Element;
|
|
begin
|
|
while not Fini and (2*P <= N) loop
|
|
|
|
-- Recherche du fils max
|
|
Fils_Max := 2*P;
|
|
if (2*P + 1 <= N) and then Cle_De(T.Les_Elements(2*P+1)) > Cle_De(T.Les_Elements(2*P)) then
|
|
Fils_Max := 2*P+1;
|
|
end if;
|
|
|
|
-- S'il est mal placé...
|
|
if Cle_De(T.Les_Elements(Fils_Max)) > Cle_De(T.Les_Elements(P)) then
|
|
Aux := T.Les_Elements(P);
|
|
T.Les_Elements(P) := T.Les_Elements(Fils_max);
|
|
T.Les_Elements(Fils_max) := Aux;
|
|
|
|
|
|
P := Fils_Max;
|
|
else -- ...ou s'il est bien placé
|
|
Fini := True;
|
|
end if;
|
|
end loop;
|
|
end Move_Down;
|
|
|
|
-- Fonction interne, place correctement un element en montant
|
|
procedure Move_Up(E : in Natural; T : in out Un_Tas) is
|
|
I : Natural := E;
|
|
P : Natural := I/2;
|
|
Aux : Element;
|
|
begin
|
|
--Put_Line(Integer'Image(I) & " " & Integer'Image(P) & " DEBUG");
|
|
while I > 1 and then Cle_De(T.Les_Elements(P)) < Cle_De(T.Les_Elements(I)) loop
|
|
Aux := T.Les_Elements(P);
|
|
T.Les_Elements(P) := T.Les_Elements(I);
|
|
T.Les_Elements(I) := Aux;
|
|
|
|
I := P;
|
|
P := I / 2;
|
|
end loop;
|
|
end Move_Up;
|
|
|
|
|
|
-- Retirer la racine du tas et la retourne
|
|
procedure Enlever_Racine(T : in out Un_Tas; E : out Element) is
|
|
begin
|
|
if T.Cardinal = 0 then raise Tas_Vide;
|
|
else
|
|
E := T.Les_Elements(1);
|
|
T.Les_Elements(1) := T.Les_Elements(T.Cardinal);
|
|
T.Cardinal := T.Cardinal - 1;
|
|
|
|
-- On a mis le dernier élément en premiere position, mais il
|
|
-- est probablement mal placé. On le replace.
|
|
if T.Cardinal > 1 then
|
|
Move_Down(1, T);
|
|
end if;
|
|
end if;
|
|
end Enlever_Racine;
|
|
|
|
-- Ajouter un nouvel élément dans le tas
|
|
procedure Ajouter(E : in Element; T : in out Un_Tas) is
|
|
begin
|
|
if T.Cardinal = T.Les_Elements'Last then raise Tas_Plein; end if;
|
|
|
|
T.Les_Elements(T.Cardinal + 1) := E;
|
|
T.Cardinal := T.Cardinal + 1;
|
|
|
|
if T.Cardinal > 1 then
|
|
Move_Up(T.Cardinal ,T);
|
|
end if;
|
|
end Ajouter;
|
|
|
|
-- Fonction interne de tas vers string
|
|
function Tab_To_String(T : in Tab_Elements; Card : in Natural) return String is
|
|
P, N : Natural := 1;
|
|
Str : Unbounded_string;
|
|
begin
|
|
if T'Length = 0 then return "";
|
|
else
|
|
while N <= Card + N - P loop
|
|
if N > Card then N := Card; end if;
|
|
for I in P..N loop
|
|
Str := (Str & To_Unbounded_String(Element_To_String(T(I)) & " "));
|
|
end loop;
|
|
Str := (Str & ASCII.LF);
|
|
P := N + 1;
|
|
N := P + N;
|
|
end loop;
|
|
return To_String(Str);
|
|
end if;
|
|
end Tab_To_String;
|
|
|
|
-- Fonction to_string
|
|
function Tas_To_String(T : in Un_Tas) return String is
|
|
begin
|
|
return Tab_To_String(T.Les_Elements, T.Cardinal);
|
|
end Tas_To_String;
|
|
|
|
end Tas_Gen;
|