with ada.Text_IO, Ada.Integer_Text_IO; with Ada.Numerics.Discrete_Random; with Ada.Command_Line; use ada.Text_IO; use Ada.Command_Line; -- Lib C pour intefacer avec le system with Interfaces.C; use Interfaces.C; procedure Test_Tri is -- Variables globales TMP : constant Duration := 0.05; INTE : Integer := 0; -- Type tableau type nbr is array (Integer range <>) of Integer; type Grille is array (Integer range <>, Integer range <>) of character; subtype Double is Integer range 0..65535; -- Pointeurs type P_procedure is access procedure (Tab, Aff : in out Nbr); -- Package pour l'aléatoire package Aleatoire is new Ada.Numerics.Discrete_Random(Double); use Aleatoire; Hasard : Generator; -- Commandes systeme via C function System (Cmd : Interfaces.C.Char_Array) return Interfaces.C.int; pragma Import (C, System, "system"); -- Procédure d'affichage d'un tableau de manière graphique procedure Aff (Tab : in Nbr) is Hauteur : constant Integer := 40; Value : Integer := 0; G : Grille(Tab'First..Hauteur, Tab'range) := (others => (others => ' ')); Max : Integer := 0; Err : Interfaces.C.int; begin Err := System("clear"); -- Recherche du max for K in Tab'Range loop if Value < Tab(K) then Max := K; Value := Tab(K); end if; end loop; Value := 0; -- Préparation affichage for I in Tab'Range loop Value := ((Tab(I)*Hauteur)/(Tab(Max)+1)); for J in G'First(2)..Value loop G(J,I) := '|'; end loop; end loop; --Affichage for H in G'Range(1) loop for V in G'Range(2) loop Put(G(G'Last-H+1,V) & ""); end loop; New_Line; end loop; --delay 0.05; end Aff; -- Procédure de tri d'un tableau (Tri bulle) procedure Tri_Bulle (Tab, Affi : in out Nbr) is K : Integer := 0; -- buffer begin for J in Tab'Range loop for I in Tab'First..(Tab'Last - 1) loop if Tab(I + 1) < Tab(I) then K := Tab(I + 1); Tab(I + 1) := Tab(I); Tab(I) := K; end if; end loop; Aff(Tab); delay TMP; end loop; end Tri_Bulle; -- Tri selection procedure Tri_Selection (Tab, Affi : in out Nbr) is VMin : Integer := Integer'last; Min : Integer := 0; Buffer : Integer; begin for J in Tab'Range loop Vmin := Integer'Last; for I in ((Tab'First+J-1))..Tab'last loop if VMin > Tab(I) then VMin := Tab(I); Min := I; end if; end loop; Buffer := Tab(Tab'First+J-1); Tab(Tab'First+J-1) := Tab(Min); Tab(Min) := Buffer; Aff(Tab); delay TMP; end loop; end Tri_Selection; -- Tri selection - Version inversée procedure Tri_Selection_Inv (Tab, Affi : in out Nbr) is VMax : Integer := 0; Max : Integer := 0; Buffer : Integer; begin for J in Tab'Range loop Vmax := 0; for I in ((Tab'First+J-1))..Tab'last loop if VMax < Tab(I) then VMax := Tab(I); Max := I; end if; end loop; Buffer := Tab(Tab'First+J-1); Tab(Tab'First+J-1) := Tab(Max); Tab(Max) := Buffer; Aff(Tab); delay TMP; end loop; end Tri_Selection_Inv; -- Quicksort procedure Quicksort (A, affi : in out Nbr) is procedure Swap(Left, Right : Natural) is Temp : Integer := A (Left); begin A (Left) := A (Right); A (Right) := Temp; end Swap; begin if A'Length > 1 then declare Pivot_Value : Integer := A (A'First); Right : Natural := A'Last; Left : Natural := A'First; begin loop while Left < Right and not (Pivot_Value < A (Left)) loop Left := Natural'Succ (Left); end loop; while Pivot_Value < A (Right) loop Right := Natural'Pred (Right); end loop; exit when Right <= Left; Swap (Left, Right); Left := Natural'Succ (Left); Right := Natural'Pred (Right); end loop; if Right = A'Last then Right := Natural'Pred (Right); Swap (A'First, A'Last); end if; if Left = A'First then Left := Natural'Succ (Left); end if; Affi(A'First..A'Last) := A; Aff(Affi); Quicksort (A (A'First .. Right), Affi); Quicksort (A (Left .. A'Last), Affi); end; end if; end Quicksort; -- Tri stupide procedure Tri_Stupide(T, Affi : in out Nbr) is function Ordonne(T : in Nbr) return Boolean is Ord : Boolean := True; I : Integer := T'First; begin -- Ordonné ? while Ord and I < T'last loop if T(I) > T(I+1) then Ord := False; end if; I := I + 1; end loop; return Ord; end Ordonne; -- Mélange procedure Melange(T : in out Nbr) is J, Aux : Integer; begin INTE := INTE + 1; for I in T'Range loop J := (Random(Hasard) mod I) + 1; if J < I then Aux := T(I); T(I) := T(J); T(J) := Aux; end if; end loop; end Melange; begin while not Ordonne(T) loop Melange(T); Aff(T); delay TMP; end loop; Aff(T); end Tri_Stupide; -- Test de la procédure tri procedure Test_Tri (F : P_Procedure) is test_tri1 : nbr(1..80); begin Put_Line("------------------"); for J in Test_Tri1'Range loop Test_Tri1(J) := Random(Hasard); end loop; F(Test_Tri1, Test_tri1); end Test_tri; F : P_Procedure; F1 : P_Procedure; F2, F3 : P_Procedure; Iteration : Integer := 1; Go : Boolean := False; Err : Interfaces.C.int; begin --Renitialisation du générateur Reset(Hasard); if Argument_Count = 1 then if Argument(1) = "--help" then Put_Line("Algorithme d'affichage d'algorithme de tri"); Put_Line("Compatible avec les sytemes UNIX uniquement"); New_Line; Put_Line("Le nombre d'itération peut être donné en argument"); Put_Line("Argument -r pour un tri inverse"); elsif Argument(1) = "-r" then F1 := Tri_Selection_Inv'Access; Test_Tri(F1); else Iteration := Integer'Value(Argument(1)); Go := True; end if; else New_Line; --Put("Nbr de boucles : "); --Ada.Integer_Text_IO.Get(Iteration); Go := True; end if; if Go then for I in 1..Iteration loop --Test des fonctions F := Tri_Stupide'Access; F1 := Tri_Bulle'Access; F2 := Tri_Selection'Access; F3 := Quicksort'Access; Err := System("clear"); Put_Line("TRI SELECTION :"); delay 2.0; Test_Tri(F2); Err := System("clear"); Put_Line("TRI BULLE :"); delay 2.0; Test_Tri(F1); Err := System("clear"); Put_Line("TRI RAPIDE :"); delay 2.0; Test_Tri(F3); Err := System("clear"); Put_Line("TRI STUPIDE :"); delay 2.0; Test_Tri(F); end loop; end if; Put_Line(Integer'Image(INTE)); end Test_Tri;