cours_ada/semestre3/Test_Tri/test_tri.adb
2021-08-22 13:24:45 +02:00

288 lines
6.7 KiB
Ada

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;