with ada.Text_IO, Ada.Integer_Text_IO; with ada.Calendar; use ada.Text_IO; procedure Main is -- Type & package subtype chiffre is Natural range 0..9; type nbr is array (Integer range <>) of Integer; package date renames ada.Calendar; -- Variables globales FND : constant Integer := 100; -- FIND WST : constant Integer := FND - 1; -- WRITE START data_dect : nbr(1..FND); -- Ce tableau contient des nombres pour de la detection de boucle -- Le rang WST et FND sont des rangs de services -- Procédure de detection de boucle, utilise la base de données data_dect procedure detect_loop (int : in Integer) is debut_ecriture : Integer := data_dect(WST); begin for i in data_dect'First..(WST - 1) loop if int = data_dect(i) then data_dect(FND) := 1; end if; end loop; data_dect(debut_ecriture) := int; data_dect(WST) := data_dect(WST) + 1; if data_dect(WST) >= WST then raise Storage_Error; end if; end detect_loop; -- Tri par ordre croissant un tableau d'integer procedure tri (tab : in out nbr) is buffer : nbr(tab'Range); valeur : Integer := 0; pos : Integer := 0; begin for k in tab'Range loop valeur := 0; pos := tab'last; for i in tab'range loop if tab(i) >= valeur then pos := i; valeur := tab(i); end if; end loop; tab(pos):=0; buffer(k) := valeur; end loop; tab := buffer; end tri; -- Tri par ordre décroissant procedure tri_inverse (tab : in out nbr) is buffer : nbr(tab'Range); begin tri(tab); for i in tab'range loop buffer(i):=tab(tab'last-(i-1)); end loop; tab:=buffer; end tri_inverse; -- Partie opérative de l'algo de Kaprekar (nombre en deux tableaux triés, affiche et retourne la différence des nombres function operation (nombre : integer; dimension : Integer) return Integer is ord_croiss : nbr(1..dimension); ord_droiss : nbr(1..dimension); nombre_croiss : Integer := 0; nombre_droiss : Integer := 0; nombre_stock : Integer := nombre; begin -- On met le nombre dans un tableau for k in 1..dimension loop ord_croiss(k) := (nombre_stock/10**(dimension-(k))); nombre_stock := nombre_stock - ord_croiss(k)*10**(dimension-k); end loop; --tri ord_droiss := ord_croiss; tri(ord_croiss); tri_inverse(ord_droiss); for j in 1..dimension loop nombre_droiss := nombre_droiss + ord_droiss(j) * (10**(dimension - (j))); nombre_croiss := nombre_croiss + ord_croiss(j) * 10**(dimension -(j)); end loop; Put_Line("N1 = " & Integer'Image(nombre_croiss) & " N2 = " & Integer'Image(nombre_droiss) & " N1 - N2 = " & Integer'Image(nombre_croiss - nombre_droiss)); return nombre_croiss - nombre_droiss; end operation; -- Permet de déterminer la taille d'un nombre function nb_digits (nombre : Integer) return Integer is dimension_nok : Boolean := true; dimension : Integer := 0; i : Integer := 0; begin while dimension_nok loop if (nombre / 10**i) <= 0 then dimension_nok := false; dimension := i; else i := i + 1; end if; end loop; if dimension = 0 then dimension := 1; end if; return dimension; end nb_digits; -- Procédure de coordination des fonctions de l'algorithme et de la detection de boucle procedure kaprekar (nombre : in out Integer) is dimension_nok : Boolean := true; dimension : Integer := 0; i : Integer := 0; temp : Integer := nombre; begin nombre := temp + 1; while nombre /=temp loop dimension := nb_digits(temp); nombre := temp; temp := operation(temp, dimension); detect_loop(temp); if data_dect(FND) = 1 then Put_Line("Boucle dans l'algorithme"); nombre := temp; end if; delay 0.2; Put_Line("--------------"); end loop; end kaprekar; -- Procédure de test de la fonction tri -- cf ../../Test_tri pour d'autres algorithmes de tri procedure test_tri is test_tri1 : nbr(1..10) := (5,4,8,3,9,1,6,7,2,0); test_tri2 : nbr(1..10) := (5,4,8,6,9,1,6,7,7,0); begin tri(test_tri2); tri_inverse(test_tri1); for i in test_tri1'First..test_tri1'Last loop put(Integer'Image(test_tri1(i))& " "); end loop; Put_Line(""); for i in test_tri2'First..test_tri2'Last loop put(Integer'Image(test_tri2(i))& " "); end loop; Put_Line(""); end test_tri; nombre: Integer := 0; begin -- Detection de boucle: data_dect(WST) := 1; --le premier rang écrit par défaut est le 1 data_dect(FND) := 0; --aucune boucle n'est trouvé au début --Put_Line("Test du programme :"); --test_tri; -- Put("Algorithme de Kaprekar. Saisir un nombre : "); Ada.Integer_Text_IO.Get(nombre); kaprekar(nombre); Put_Line("ALGORITHME FINI"); -- Exceptions exception when Constraint_Error => Put_Line("Nombre donné non valide."); when Storage_Error => Put_Line("DATA_BASE_TOO_SHORT, data_dect(WST):"&Integer'Image(data_dect(WST))); when others => Put_line("Nombre non valide ou trop grand !"); end Main;