Anagrammes

Supposons qu'on veuille faire un programme qui affiche les combinaisons d'une chaîne de caractères; par exemple les anagrammes des lettres de "abc" sont "abc, acb, bac, bca, cab, cba".

Pour réaliser ce programme nous allons commencer par des petites chaînes, et nous allons d'abord le faire de manière itérative.

Pour "a", toutes les combinaisons sont : "a".

Pour "ab", toutes les combinaisons sont : "ab,ba".

On remarque que ces combinaisons ne sont en fait qu'une rotation de la chaîne initiale vers la gauche, et ceci 2 fois de suite.

On peut donc en déduire l'algorithme général, qui ne sera constitué que de rotations successives vers la gauche.

Pour "abc", toutes les combinaisons sont :

première rotation : "bca" suivi d'une rotation de "ca" donc "bac"

suivi de 2 rotations de "ca" donc "bca"

deuxième rotation : "cab" suivi d'une rotation de "ab" donc "cba"

suivi de 2 rotations de "ca" donc "cab"

troisième rotation : "abc" suivi d'une rotation de "bc" donc "acb"

suivi de 2 rotations de "bc" donc "abc"

Nous allons écrire la procédure qui affiche les combinaisons des lettres d'une chaîne de 3 caractères.

procedure combinaison(st: string);
var i1, i2, i3: integer;
 tete1, tete2, reste1, reste2: string;
begin
 for i1 := 1 to 3 do
 begin
 tete1 := st[1];
 reste1 := copy(st, 2, length(st) - 1);
 st := reste1;
 for i2 := 1 to 2 do
 begin
 tete2 := st[1];
 reste2 := copy(st, 2, length(st) - 1);
 st := reste2;
 for i3 := 1 to 1 do
 memo1.lines.add(tete1 + tete2 + st); { on affiche les têtes successives }
 st := reste2 + tete2; { ici on fait la rotation }
 end;
 st := reste1 + tete1; { ici on fait la rotation }
 end;
end;
 

Nous allons transformer maintenant cette procédure itérative en une procédure récursive. On obtient la procédure suivante, qui est appelée avec l'instruction "combinaison('abc','');" :

procedure combinaison1(st, tete: string);
var i: integer;
 tete_local, reste_local: string;
begin
 if length(st) = 1 then memo1.lines.add(tete + st)
 else
 for i := 1 to length(st) do
 begin
 tete_local := st[1];
 reste_local := copy(st, 2, length(st) - 1);
 combinaison1(reste_local, tete + tete_local);
 st := reste_local + tete_local;
 end;
end;
 

Maintenant on peut supprimer les variables locales qui sont "tete_local" et "reste_local" et on obtient :

procedure combinaison2(st, tete: string);
var i: integer;
begin
 if length(st) = 1 then memo1.lines.add(tete + st)
 else
 for i := 1 to length(st) do
 begin
 combinaison1(copy(st, 2, length(st) - 1), tete + st[1]);
 st := copy(st, 2, length(st) - 1) + st[1];
 end;
end;
 

Une autre solution à ce problème, et qui appartient à mon ancien professeur d'informatique de lycée, est la suivante :

on prend un mot et on permute sa première lettre avec chacune des autres lettres. Ensuite pour chacun des nouveaux mots obtenus, on ne touche pas à la première lettre et à partir de la deuxième lettre on refait les permutations entre la deuxième lettre et toutes les autres lettres jusqu'à la fin; ensuite pour chacun des nouveaux mots obtenus, on ne touche pas à la deuxième lettre et à partir de la troisième lettre on refait les permutations entre la troisième lettre et toutes les autres lettres jusqu'à la fin; on voit donc la récursivité :

procedure combinaisons;
var ch: string;
 l: byte;
 
 procedure EchangeCar(var ch: string; i, j: byte);
 var car: char;
 begin
 if i <> j then
 begin
 car := ch[i];
 ch[i] := ch[j];
 ch[j] := car;
 end
 end;
 
 procedure anagram(ch: string; i: byte);
 var j: byte;
 begin
 if i = l then memo1.lines.add(ch)
 else
 for j := i to l do
 begin
 EchangeCar(ch, i, j);
 Anagram(ch, i + 1);
 EchangeCar(ch, i, j);
 end;
 end;
 
begin
 ch := 'abc'; l := length(ch);
 anagram(ch, 1);
end;

Télécharger le code source Delphi