IdentifiantMot de passe
Mot de passe oublié ?Je m'inscris ! (gratuit)

GENÈSE D'UN DICTIONNAIRE

Construction d'un lexique interactif avec Lazarus

précédentsommairesuivant

Classements et approximations▲

Introduction▲

Nous disposons maintenant d'une solide liste de mots et d'un moteur permettant de les relier autant de fois que l'on souhaite, ce qui ouvre l'horizon vers des recherches de corrélation.

Le moteur est brut de décoffrage, avec des liens qui apparaissent dans l'ordre de leur création : un classement automatique serait plus rationnel.

Par ailleurs, les jeux de mots croisés, qui sont notre cible principale, s'accommodent de lettres non accentuées ; les recherches doivent donc porter non seulement sur l'identité d'un mot avec un autre, mais sur leur ressemblance.

Notion floue… que nous allons éclaircir.

Environnement▲

Chapitre 7…

Créons un répertoire Lex7 et recopions dans ce nouveau répertoire tous les fichiers du répertoire Lex6 utilisé précédemment. Pour éviter toute difficulté ultérieure, suivez la check-list :

  • ouvrir pLex6.lpi dans Lex7 avec Lazarus ;
  • enregistrer uLex6.pas sous le nom de uLex7.pas ;
  • accepter la suppression des références à uLex6.pas ;
  • enregistrer pLex6.pas sous le nom de pLex7.pas ;
  • renommer la fenêtre Form1 : Lex6 devient Lex7 ;
  • dans le répertoire Lex7, supprimer les anciens fichiers contenant la mention Lex6.

Nous retrouvons le projet dans l'état où nous l'avions laissé, et les modifications que nous allons effectuer n'affecteront pas l'étape précédente consultable dans le répertoire Lex6.

Onglet Balayage▲

L'onglet Balayage se révèle pratique pour parcourir la liste et, avec son filtre, accéder immédiatement aux mots déjà liés.

L'onglet Édition a l'avantage de faire apparaître la liste des mots liés au mot-titre.

Pour rendre l'interface plus simple, nous remplaçons le Memo de l'onglet Balayage par un ListBox qui affichera les liens.

Dans les propriétés du composant Listbox, nous supprimons les bordures : BorderStyle est basculé sur bsNone.

Nous réduisons la hauteur des deux flèches et plaçons le composant filtre juste au-dessus.

Pour établir un lien visuel entre le mot-titre et ses mots liés, nous allons affecter aux composants Label2 et ListBox2 une même couleur pastel et nous vous proposons la teinte $00C1FFDC (valeur hexa à placer à la ligne Color). Toute autre teinte claire peut convenir.

Image non disponible Pour modifier la teinte de fond d'un composant, cliquez sur la ligne Color dans l'inspecteur d'objets : un premier choix est proposé.
Pour définir d'autres teintes, cliquez sur les trois points pour faire apparaître la palette complète.
Cliquez sur le carré principal pour choisir la couleur, puis ajustez l'intensité avec le curseur situé à sa droite.
Cliquez sur le bouton Ajouter… pour que la valeur numérique soit insérée dans la propriété.

L'ensemble se présente maintenant comme ceci :

Image non disponible

La procédure AffLiens, qui prend en charge l'affichage des liens dans l'onglet Édition, est modifiée pour que le nouveau ListBox soit mis à jour systématiquement :

 
Sélectionnez
procedure TForm1.AffLiens;
var i, k : integer;
begin
 if Length(Liens)>0 then
 begin
   ListBox1.Clear;
   k := chercheTab(iMot);
   if k>=0 then
     for i :=1 to Length(Liens[k]) -1 do
       ListBox1.Items.Add(AnsiToUTF8(listeMots[Liens[k, i]]));
   ListBox2.Items := ListBox1.Items;
 end;
end;

Mais l'onglet Balayage doit à son tour être mis à jour si l'utilisateur a l'idée de cliquer sur le composant ListBox : dans l'onglet Événements de ce composant, ligne OnClick, cliquez sur les trois points pour créer la procédure événementielle correspondante :

 
Sélectionnez
procedure TForm1.ListBox2Click(Sender: TObject);
begin
 If ListBox2.ItemIndex >= 0 then
 begin
   iMot := Liens[chercheTab(iMot), ListBox2.ItemIndex+1];
   MAJBalayage;
 end;
end;

La première instruction vérifie la présence d'un lien à l'emplacement du clic ; si c'est le cas, la mise à jour de l'onglet Balayage est réalisée.

Lancez l'exécution et essayez… L'ergonomie est déjà plus agréable.

Image non disponible

Tri des liens▲

Les liens sont enregistrés dans le tableau principal Lien et dans les tableaux secondaires Liens[i] dans l'ordre de leur création, ce qui ne présente aucune difficulté théorique ou pratique. Le résultat est toutefois peu satisfaisant pour deux raisons :

  • au plan esthétique, l'Å“il s'accommode mal du désordre qui apparaît dans l'affichage des liens ;
  • au plan logique, la recherche dans un tas est plus longue que dans une liste ordonnée.

Pour les tableaux secondaires, la solution « épidermique » est simple : il suffit d'affecter à True la propriété Sorted du composant ListBox. Essayez…

L'affichage se fait maintenant dans le bon ordre. Mais…

Si vous cliquez sur un lien, le résultat obtenu est… imprévu. En effet, la mise à jour de l'affichage se fait non pas selon le mot cliqué dans la liste, mais selon sa position.

Et le tri effectué par le composant a modifié sa position…

Il faut donc envisager le tri systématique des tableaux, et le renouveler à chaque création de lien.

Tri des tableaux secondaires▲

La première case restera inchangée, puisque c'est l'identifiant du tableau. Les autres cases seront classées par ordre croissant.

La dernière case est celle qui est affectée en dernier : nous allons donc procéder à une simple remontée jusqu'à ce que la case précédente contienne une valeur inférieure, et nous répéterons l'opération jusqu'à ce qu'aucune permutation n'ait été effectuée.

Pour le tableau Liens[k], nous utiliserons la fonction TriSec(k), qui retournera vrai si aucune permutation n'a été effectuée.

Rappelons qu'une nouvelle fonction ou procédure doit faire d'abord l'objet d'une déclaration avant implémentation (ici on écritfunction TriSec(k : integer) : boolean; suivi d'un appui sur les trois touches Ctrl+Maj+C.

Le code est le suivant(19) :

 
Sélectionnez
function TForm1.TriSec(k: integer): boolean;
var i, Tamp : integer;
begin
  TriSec := True;
  for i := Length(Liens[k]) - 1 downto 2 do
    if Liens[k, i] < Liens[k, i-1] then  
    begin
      Tamp :=  Liens[k, i];
      Liens[k, i] := Liens[k, i-1];
      Liens[k, i-1] := Tamp;
      TriSec := False;
    end;
end;

Notons que la première case (k=0) n'est pas modifiée.

Nous répéterons le balayage jusqu'à ce que la fonction retourne vrai.

Pour lancer le tri de tous les tableaux secondaires, nous plaçons un bouton dans l'onglet Info, et nous lui affectons « TriSec » à la propriété Caption.

Image non disponible

Un double clic sur ce nouveau bouton pour créer la procédure Button4Click que l'on peut écrire ainsi :

 
Sélectionnez
procedure TForm1.Button4Click(Sender: TObject);
var k : integer;
    okTri : boolean;
begin
   for k := 0 to Length(Liens)-1 do
     if (Length(Liens[k]) > 2) then
        repeat
           okTri := TriSec(k);
        until okTri;
end;

La variable k balaye successivement tous les tableaux secondaires ; si le tableau considéré contient plus de deux liens, un premier tri est lancé, puis un second, jusqu'à ce qu'aucune permutation n'ait été effectuée (okTri est vrai) ; on passe alors au tableau secondaire suivant.

Exécution : cliquez sur le petit triangle vert et vérifiez que, après action sur le bouton TriSec, tous les tableaux secondaires ont bien été triés.

Si vous quittez le programme en cliquant sur le bouton rouge, le tri est perdu. Si vous actionnez le bouton Arrêt du premier onglet, le tri est conservé.

Tri du tableau principal▲

Nous allons utiliser les mêmes méthodes pour mettre de l'ordre dans le tableau principal, c'est-à-dire ranger les tableaux secondaires dans l'ordre croissant de leur identifiant. La fonction TriPPal peut s'écrire ainsi :

 
Sélectionnez
function TForm1.TriPPal: boolean;
var i : integer;
    Tamp : Array of integer;
begin
  TriPPal := True;
  for i := Length(Liens) - 1 downto 1 do
    if Liens[i, 0] < Liens[i-1, 0] then
    begin
      Tamp :=  Liens[i];
      Liens[i] := Liens[i-1];
      Liens[i-1] := Tamp;
      TriPPal := False;
    end;
end;

Image non disponible

Pour lancer ce tri, nous ajoutons un bouton dans l'onglet Info, baptisé TriPPal, et dans la procédure onClick de ce composant, nous complétons le code :

 
Sélectionnez
procedure TForm1.Button5Click(Sender: TObject);
var i : integer;
begin
 for i := 0 to Length(Liens) - 1 do
    Memo2.Append(listeMots[Liens[i, 0]]);
 repeat
 until TriPPal;
 for i := 0 to Length(Liens) - 1 do
    Memo2.Append(listeMots[Liens[i, 0]]);
end;

Les deux premières lignes affichent les mots liés dans l'ordre d'origine ; les deux suivantes font le tri, les deux dernières affichent le résultat.

Pour que le Memo puisse être consulté aisément, n'oubliez pas de porter sa propriété ScrollBar à AutoVertical.

Lancez l'exécution, cliquez sur le bouton TriPPal et appréciez(20)…

Pour la suite du projet, nous supposerons que les tris (secondaire et principal) ont été effectués et mémorisés en quittant le programme par le bouton Arrêt.

Ajout d'un lien▲

Après ajout d'un lien, l'ordre du tableau de liens est probablement détruit. Doit-on lancer le tri général du tableau permis par la fonction TriSec ? Cette fonction impose au moins deux balayages du tableau : un premier pour effectuer les éventuelles permutations, un second pour contrôler que tout est déjà en place.

Mais si le tableau est déjà trié et que le nouveau lien figure en dernière position, il suffit de faire monter sa position jusqu'à ce que l'index qui le précède soit inférieur. Cela remplace deux balayages par un demi… en moyenne… d'où l'intérêt du tri.

La procédure PlaceLiens(k) peut s'écrire ainsi :

 
Sélectionnez
procedure TForm1.PlaceLien(k: integer);
var i, Tamp : integer;
begin
 i := Length(Liens[k]) - 1;
 while (Liens[k, i] < Liens[k, i-1]) and (i>1)  do
 begin
      Tamp :=  Liens[k, i];
      Liens[k, i] := Liens[k, i-1];
      Liens[k, i-1] := Tamp;
      Dec(i);
 end;
end;

Il faut déclencher ce tri au moment où le nouveau lien est intégré dans le tableau, donc en fin de la procédure Lier, qui devient :

 
Sélectionnez
procedure TForm1.Lier(iMot, iLien: integer);
var k : integer;
begin
  k := chercheTab(iMot);
  if k < 0 then
  begin
     SetLength(Liens, Length(Liens)+1); //extension du tableau principal
     k := Length(Liens)-1;
     SetLength(Liens[k], 1);
     Liens[k][0] := iMot; //identifiant
     Inc(nLiens); //mise à jour du nombre de mots liés
     Caption := 'Lex6 '+IntToStr(nMots)+ ' mots dont '
                       +IntToStr(nLiens) + ' liés';
  end;
  SetLength(Liens[k], Length(Liens[k])+1);  //extension du tableau secondaire
  Liens[k, Length(Liens[k])-1] := iLien;  // lien
  PlaceLien(k);                           //tri
end;

Essayez : clic sur le triangle vert, naviguez jusqu'au mot « couleur » (onglet Balayage), ajoutez un lien avec « bleu » (onglet Édition)… Celui-ci est immédiatement placé convenablement.

Avant de quitter (bouton Arrêt), cliquez sur le bouton TriPPal pour que le tableau correspondant au mot « bleu » soit positionné à la bonne place : le Memo vous confirmera que, parmi les mots liés, le mot « bleu » a bien quitté la dernière position.

Création d'un tableau secondaire▲

Lors de la création d'un tableau secondaire (un lien est affecté à un mot qui n'en possédait pas), le nouveau tableau est placé en fin de liste : k:=Length(Liens)-1 (procédure ci-dessus).

Pour donner au nouveau tableau la place qui lui revient, on applique la même méthode que pour le tri des liens, avec une fonction PlaceTab qui retourne la nouvelle position du tableau.

 
Sélectionnez
function TForm1.PlaceTab(k: integer): integer;
var i : integer;
    Tamp : Array of integer;
begin
 i := k;
 while (Liens[i, 0] < Liens[i-1, 0]) and (i>1)  do
    begin
      Tamp :=  Liens[i];
      Liens[i] := Liens[i-1];
      Liens[i-1] := Tamp;
      dec(i);
    end;
 PlaceTab := i;
end;

La procédure Lier doit donc être à nouveau modifiée pour que la nouvelle position soit prise en compte :

 
Sélectionnez
procedure TForm1.Lier(iMot, iLien: integer);
var k : integer;
begin
  k := chercheTab(iMot);
  if k < 0 then
  begin
     SetLength(Liens, Length(Liens)+1); //extension du tableau principal
     k := Length(Liens)-1;
     SetLength(Liens[k], 1);
     Liens[k][0] := iMot; //identifiant
     k := PlaceTab(k);    //nouvel emplacement
     Inc(nLiens); //mise à jour du nombre de mots liés
     Caption := 'Lex6 '+IntToStr(nMots)+ ' mots dont '
                       +IntToStr(nLiens) + ' liés';
  end;
  SetLength(Liens[k], Length(Liens[k])+1);  //extension du tableau secondaire
  Liens[k, Length(Liens[k])-1] := iLien;  // lien
  PlaceLien(k);                           //tri
end;

Essayez à nouveau en ajoutant au mot « couleur » un lien avec « orange »…

Pensez à quitter en utilisant le bouton du premier onglet.

Le tableau de liens est maintenant ordonné systématiquement, de même que chacun des tableaux secondaires.

Les boutons TriSec et TriPPal sont maintenant inutiles, ainsi que les procédures correspondantes. Nous pouvons les conserver provisoirement, pour rétablir le bon ordre de tous les liens en cas d'incident (coupure de courant, plantage…).

Suppression d'un lien▲

Il peut s'avérer nécessaire de supprimer un lien existant. Cette opération sera traitée dans un onglet dédié, par mesure de prudence.

Dans la fenêtre Lex7, clic droit dans la ligne en grisé, à droite de l'onglet Édition : dans le menu contextuel, choisir Ajouter une page. Dans l'inspecteur d'objets, inscrire « Suppression » dans la propriété Caption.

Dans le nouvel onglet, on ajoute quatre composants :

  • un label (propriété Font/Size portée à 14) ;
  • un listBox ;
  • un second label ;
  • et un bouton (propriété Caption portée à « OK »).

Image non disponible

Nous désirons que le mot titre et les liens qui apparaissent dans l'onglet Balayage soient répliqués sur notre nouvel onglet ; un clic sur l'un des liens affichera un avertissement dans le second label et activera le bouton.

La procédure MAJSupp peut s'écrire ainsi :

 
Sélectionnez
procedure TForm1.MAJSupp;
begin
  Label5.Caption := Label2.Caption;
  ListBox4.Items := ListBox2.Items;
  Label6.Caption:= '';
  Button6.Enabled:= False;
end;

La procédure MAJBalayage est complétée par l'instruction MAJSupp ;

 
Sélectionnez
procedure TForm1.MAJBalayage;
var i : integer;
begin
   Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
   Label3.Caption:= Label2.Caption;
   Label4.Caption:=Label2.Caption;
   TrackBar1.Position:= Round(iMot*1000/nMots);
   Edit2.Clear;
   AffListe.Clear;
   for i := 0 to 10 do
       AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-5 + i + nMots) mod nMots]));
   AffListe.Selected[5] := True;
   AffLiens;
   Caption := 'Lex7 '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens) + ' liés';
   MAJSupp;
end;

Pour sélectionner un lien dans l'onglet Suppression, nous utilisons l'événement OnClick :

 
Sélectionnez
procedure TForm1.ListBox4Click(Sender: TObject);
begin
  if ListBox4.ItemIndex >= 0 then
  begin
    iLien := Liens[chercheTab(iMot), ListBox4.ItemIndex+1];
    Label6.Caption:= 'Supprimer le lien entre '+
                      AnsiToUTF8(listeMots[iMot]) +  ' et '+
                      AnsiToUTF8(listeMots[iLien])+ ' ?';
    Button6.Enabled := True;
  end;
end;

La procédure affecte à la variable iLien l'index du lien à supprimer : il faut déclarer cette variable avant implémentation.

 
Sélectionnez
var
  Form1: TForm1;
  listeMots, listeInfo : TstringList;
  iMot, nMots, nLiens, iLien : integer;
  AffListe : TListBox;
  Liens : Array of Array of integer;

La suppression d'un lien s'accompagne de la réduction de la taille du tableau secondaire, et même de celle du tableau principal si ce lien était le dernier :

 
Sélectionnez
procedure TForm1.SuppLien(iMot, iLien: integer);
var i, k : integer;
begin
//dans le tableau secondaire de iMot, on supprime iLien
  k := chercheTab(iMot);
  i:=1;
  while Liens[k, i]<> iLien do inc(i);
  while (i<Length(Liens[k])-1) do
  begin
     Liens[k, i] :=  Liens[k, i+1];
     inc(i);
  end;
  SetLength(Liens[k], Length(Liens[k]) - 1);//tableau secondaire
  if (Length(Liens[k]) = 1) then  //le mot n'a plus de lien
  begin
    for i := k to Length(Liens)-2 do
      Liens[i] := Liens[i+1];
    SetLength(Liens, Length(Liens)-1);       //tableau principal
    nLiens := Length(Liens);
  end;
  MAJBalayage;
end;

Le clic sur le bouton OK lance la suppression dans un sens, puis dans l'autre :

 
Sélectionnez
procedure TForm1.Button6Click(Sender: TObject);
begin
  SuppLien(iMot, iLien);
  SuppLien(iLien, iMot);
end;

Un clic sur le petit triangle vert pour essayer les nouvelles fonctions : il est possible maintenant d'ajouter et de retirer à volonté tous les liens que l'on souhaite.

Le bouton Arrêt du premier onglet assure la sauvegarde du résultat.

Image non disponible

Mots approchés▲

La pratique un peu laborieuse des tableaux dynamiques nous a éloignés - provisoirement - du sujet principal que constituent les mots croisés. Oublions les majuscules et intéressons-nous aux lettres ou caractères particuliers.

Principes▲

Voici un tableau de 18 caractères, se terminant avec le tiret, l'apostrophe et l'espace :

|à|â|ä|é|è|ê|ë|î|ï|ô|ù|û|ü|ÿ|ç|-|'| |

Dans une grille de mots croisés(21), par convention non écrite, tous sont remplacés par leur homologue dans le tableau suivant(22) :

|a|a|a|e|e|e|e|i|i|o|u|u|u|y|c||||

les trois derniers étant… l'absence de caractère.

Inconsciemment, le joueur remplace tous les caractères du premier tableau par les caractères correspondants du second.

La fonction de recherche que nous avons utilisée précédemment ne s'accommode pas d'un tel laxisme : elle exige l'identité de deux chaînes, caractère par caractère. Il nous faut donc l'enrichir en complétant le signal d'erreur « échec » par l'affichage de mots « approchés » au sens des mots croisés.

Méthode▲

Nous avons déjà vu que la liste de mots était stockée selon le format simplifié à la norme ANSI alors que les affichages sur notre interface graphique exigeaient le format UTF8. Nous avons réglé le problème en adoptant les fonctions de conversion AnsiToUTF8 dans un sens et UTF8ToAnsi de l'autre.

Pour les recherches de mots approchés, il nous faudra comparer des chaînes de caractères débarrassées des lettres accentuées et des majuscules. Le tableau suivant résume les propriétés de nos chaînes selon la phase de leur utilisation :

Propriétés de la chaîne Stockage Identité Approx
Type ANSI ANSI ANSI
Présence de majuscules Oui Oui Non
Affichage interface graphique UTF8 UTF8 UTF8
Lettres accentuées Oui Oui Non
Majuscules accentuées Non Non Non

Pour des raisons de simplification, nous considérons que les majuscules accentuées ne présentent pas d'intérêt… mais il sera toujours temps d'y revenir si nécessaire.

Les traitements sont au format ANSI et les affichages au format UTF8 : commençons par corriger la procédure onClick qui déclenche la recherche :

 
Sélectionnez
procedure TForm1.Button2Click(Sender: TObject);
begin
  Recherche(UTF8ToAnsi(Edit2.Caption));
end;

Interface graphique▲

Reprenons l'onglet 1 de l'interface, que nous rebaptisons en « Recherche » (propriété Caption).

Nous ajoutons un composant TListBox, avec la propriété Color égale à $00C4F3FF (autre couleur pastel, mais vous pouvez en adopter d'autres). Nous fixons la même couleur au composant Edit2 pour que la liaison entre les deux soit visuellement établie. Après quelques déplacements des composants, nous obtenons une interface qui peut ressembler à ceci :

Image non disponible

L'objectif est de permettre la saisie d'un mot dans le composant Edit2, et d'afficher, après consultation de la liste principale :

  1. le mot identique dans le Label ;
  2. les mots approchés dans le ListBox.

Élimination des accents▲

La chaîne à rechercher, rMot, est débarrassée de ses majuscules puis balayée du premier caractère au dernier. Si l'un d'entre eux se trouve dans le tableau des lettres accentuées, il est remplacé par le caractère homologue du tableau des lettres non accentuées. La fonction SansAccent peut s'écrire ainsi :

 
Sélectionnez
function TForm1.SansAccent(rMot: string): string;
var i, j : integer;
    cAcc, sAcc : string;
begin
 cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
 //regroupe tous les caractères à remplacer
 sAcc := 'aaaeeeeiiouuuyc';
 //regroupe tous les caractères de substitution
 SansAccent := '';
 rMot := LowerCase(rMot);
 for i:=1 to Length(rMot) do
   begin
     j := Pos(rMot[i], cAcc);
     case j of
       0     : SansAccent := SansAccent + rMot[i];
       1..15 : SansAccent := SansAccent + sAcc[j];
     end;
   end;
end ;

Le recours à cette procédure sera fréquent. Il sera donc judicieux d'envisager la création de constantes globales pour les deux chaînes cAcc et sAcc, ce qui évitera des affectations à répétition.

Balayage de la liste principale▲

La recherche de mots approchés va débuter à partir du premier mot qui commence avec la même première lettre et se terminera lorsque l'on atteindra la première lettre suivante. La comparaison porte sur deux chaînes débarrassées de leurs accents.

Les résultats positifs sont affichés dans le ListBox et les indices stockés dans un tableau d'entiers tabApprox, pour réemploi éventuel. Nous commençons par déclarer cette variable globale avant implémentation :

tabApprox : Array of integer ;

Il s'agit bien d'un tableau dynamique, et il va falloir ajuster sa longueur avant chaque utilisation, mais maintenant nous avons l'habitude…

 
Sélectionnez
procedure TForm1.listeApprox(rechMot: string);
var i, k : integer;
    referMot, testMot : string;
begin
 SetLength(tabApprox, 0);   //mise à zéro du tableau
 referMot := SansAccent(rechMot); //gabarit de référence
    //point de démarrage de la recherche : première lettre du mot
    i := 0;
    while SansAccent(listeMots[i][1]) < referMot[1] do inc(i);
    //début de la recherche
    repeat
      if SansAccent(listeMots[i]) = referMot then  //pseudo-identité
      begin
         listBox3.Items.Append(AnsiToUTF8(listeMots[i]));
         //enregistrement des index pour réutilisation
         SetLength(tabApprox, Length(tabApprox)+1);
         tabApprox[Length(tabApprox)-1] := i;
      end;
      inc(i)
    until (i>nMots-1) or (SansAccent(listeMots[i][1]) > referMot[1]);
   //la première lettre a changé
end;

Quant à la procédure Recherche, il faut la compléter pour provoquer une recherche complémentaire :

 
Sélectionnez
procedure TForm1.Recherche(rechMot: string);
var irechMot : integer;
begin
 listBox3.Clear;
 irechMot := listeMots.IndexOf(rechMot);
 if irechMot >= 0 then
  begin
    Label1.Caption:= AnsiToUTF8(listeMots[irechMot]);
    iMot := irechMot;
    MAJBalayage;
  end
  else
  begin
    Label1.Caption:= 'échec';
    listeApprox(rechMot);
  end;
end;

Essai d'exécution avec un clic sur le petit triangle vert.

Dans la zone de saisie, on entre par exemple « macon » et on clique sur le bouton Chercher.

Le résultat « échec » indique qu'aucune correspondance n'a été trouvée.

Par contre, le ListBox affiche les mots approchants : « maçon » et « mâcon ».

Objectif atteint.

Image non disponible

Que se passe-t-il si l'on clique sur le mot « maçon » par exemple ? Pour l'instant, rien. Il faut exploiter l'événement onClick du composant(23), et la procédure peut s'écrire comme suit :

 
Sélectionnez
procedure TForm1.ListBox3Click(Sender: TObject);
begin
 if ListBox3.ItemIndex>=0 then
 begin
  iMot := tabApprox[ListBox3.ItemIndex];
  Label1.Caption:=AnsiToUTF8(listeMots[iMot]);
  Edit2.Clear;
  ListBox3.Clear;
  MAJBalayage;
 end;
end;

Clic sur le triangle vert pour lancer l'exécution.

Et là l'existence de la variable tabApprox montre son intérêt.

Conclusion▲

Nous savons maintenant ranger les listes de liens dans un ordre qui accélère les accès.

Par ailleurs, l'entrée d'un mot nouveau provoque, dans l'onglet Recherche, l'apparition d'une liste de mots approchants. Cette liste constituera un élément décisif lors de l'introduction d'un mot nouveau : c'est ce que nous verrons au prochain chapitre.

Une petite fantaisie pour terminer : voici un dessin exécuté sur smartphone mais pouvant servir d'icône originale à notre logiciel :

Image non disponible

Ce n'est pas une œuvre d'art, plutôt un appel aux bonnes volontés !

Il vaut mieux ne pas réfléchir du tout que de ne pas réfléchir assez.
Tristan Bernard.

Le code… L'unité uLex7 se présente maintenant comme suit :

 
Sélectionnez
unit uLex7;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls,
  Graphics, Dialogs, StdCtrls, ComCtrls, uDisque;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    ListBox4: TListBox;
    Memo2: TMemo;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    Zoom: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    AffListe: TListBox;
    Memo1: TMemo;
    PageControl1: TPageControl;
    Page1: TTabSheet;
    TabSheet1: TTabSheet;
    TrackBar1: TTrackBar;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    procedure AffListeClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure CheckBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure ListBox3Click(Sender: TObject);
    procedure ListBox4Click(Sender: TObject);
    procedure Recherche(rechMot: string);
    procedure TrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
    procedure MAJAffichage;
    procedure MAJBalayage;
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
    procedure ZoomMouseLeave(Sender: TObject);
    procedure MAJInfo;
    function chercheTab(iMot : integer) : integer;
    procedure Lier(iMot, iLien : integer);
    procedure AffLiens;
    function TriSec(k : integer) : boolean;
    function TriPPal : boolean;
    procedure PlaceLien(k : integer);
    function PlaceTab(k : integer) : integer;
    function SansAccent(rMot : string) : string;
    procedure listeApprox(rechMot : string);
    procedure MAJSupp;
    procedure SuppLien(iMot, iLien : integer);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
const delta=5;
 
var
  Form1: TForm1;
  listeMots, listeInfo : TstringList;
  iMot, nMots, nLiens, iLien : integer;
  AffListe : TListBox;
  Liens : Array of Array of integer;
  tabApprox : Array of integer;  //index des mots approchants
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 regLiens;
 listeMots.Free;
 Application.Terminate;
end;
 
procedure TForm1.AffListeClick(Sender: TObject);
begin
   iMot := (iMot -delta + AffListe.ItemIndex + nMots) mod nMots;
   MAJBalayage;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
   Recherche(UTF8ToAnsi(Edit2.Caption));
end;
 
procedure TForm1.Button3Click(Sender: TObject);
var iLien, k : integer;
begin
   iLien := listeMots.IndexOf(UTF8ToAnsi(Edit3.Caption));
   if iLien<0 then
      ShowMessage('Ce mot n''existe pas, recommencez')
   else
   begin
     Lier(iMot, iLien);
     Lier(iLien, iMot);
     AffLiens;
   end;
   Edit3.Clear;
end;
 
procedure TForm1.Button4Click(Sender: TObject);
var k : integer;
    okTri : boolean;
begin
   for k := 0 to Length(Liens)-1 do
     if (Length(Liens[k]) > 2) then
        repeat
           okTri := TriSec(k);
        until okTri;
end;
 
procedure TForm1.Button5Click(Sender: TObject);
var i : integer;
begin
 for i := 0 to Length(Liens) - 1 do
    Memo2.Append(listeMots[Liens[i, 0]]);
 repeat
 until TriPPal;
 for i := 0 to Length(Liens) - 1 do
    Memo2.Append(listeMots[Liens[i, 0]]);
end;
 
procedure TForm1.Button6Click(Sender: TObject);
begin
  SuppLien(iMot, iLien);
  SuppLien(iLien, iMot);
end;
 
 
procedure TForm1.CheckBox1Change(Sender: TObject);
begin
  if CheckBox1.Checked then CheckBox1.Caption := 'Avec filtre'
  else CheckBox1.Caption := 'Sans filtre';
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  listeMots := TStringList.Create;
  LireFichier(listeMots);
  nMots := listeMots.Count;
  Memo1.Append('Premier mot : '+listeMots[0]);
  Memo1.Append('Dernier mot : '+listeMots[nMots-1]);
  lireLiens;
  iMot := 0;
  SetLength(tabApprox, 0);
  Edit3.Clear;
  MAJAffichage;
  MAJBalayage;
end;
 
procedure TForm1.ListBox1Click(Sender: TObject);
begin
 If ListBox1.ItemIndex >= 0 then
 begin
   iMot := Liens[chercheTab(iMot), ListBox1.ItemIndex+1];
   Label4.Caption := AnsiToUTF8(listeMots[iMot]);
   AffLiens;
 end;
end;
 
procedure TForm1.ListBox2Click(Sender: TObject); //couleur $00C1FFDC
begin
 If ListBox2.ItemIndex >= 0 then
 begin
   iMot := Liens[chercheTab(iMot), ListBox2.ItemIndex+1];
   MAJBalayage;
 end;
end;
 
procedure TForm1.ListBox3Click(Sender: TObject);
begin
 if ListBox3.ItemIndex>=0 then
 begin
  iMot := tabApprox[ListBox3.ItemIndex];
  Label1.Caption:=AnsiToUTF8(listeMots[iMot]);
  Edit2.Clear;
  ListBox3.Clear;
  MAJBalayage;
 end;
end;
 
procedure TForm1.ListBox4Click(Sender: TObject);
begin
  if ListBox4.ItemIndex >= 0 then
  begin
    iLien := Liens[chercheTab(iMot), ListBox4.ItemIndex+1];
    Label6.Caption:= 'Supprimer le lien entre '+
                      AnsiToUTF8(listeMots[iMot]) +  ' et '+
                      AnsiToUTF8(listeMots[iLien])+ ' ?';
    Button6.Enabled := True;
  end;
end;
 
procedure TForm1.MAJBalayage;
var i : integer;
begin
   Label2.Caption:=AnsiToUTF8(listeMots[iMot]);
   Label3.Caption:= Label2.Caption;
   Label4.Caption:=Label2.Caption;
   TrackBar1.Position:= Round(iMot*1000/nMots);
   Edit2.Clear;
   AffListe.Clear;
   for i := 0 to 10 do
       AffListe.Items.Add(AnsiToUTF8(listeMots[(iMot-5 + i + nMots) mod nMots]));
   AffListe.Selected[5] := True;
   AffLiens;
   Caption := 'Lex7 '+IntToStr(nMots)+ ' mots dont '+IntToStr(nLiens) + ' liés';
   MAJSupp;
end;
 
 
procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
   if CheckBox1.Checked then
   repeat
     inc(iMot);
   until (chercheTab(iMot)>=0) or (iMot=nMots)
   else
     if Button=btNext then Inc(iMot, UpDown2.Increment)
                      else Dec(iMot, UpDown2.Increment);
   iMot := (iMot + nMots) mod  (nMots);
   MAJBalayage;
end;
 
procedure TForm1.ZoomMouseLeave(Sender: TObject);
begin
   if RadioButton1.Checked then UpDown2.Increment := 1
   else if RadioButton2.Checked then UpDown2.Increment := 10
   else if RadioButton3.Checked then UpDown2.Increment := 100
   else if RadioButton4.Checked then UpDown2.Increment := 1000;
end;
 
procedure TForm1.MAJInfo;
begin
 
end;
 
function TForm1.chercheTab(iMot: integer): integer;
var i : integer;
begin
 chercheTab := -1;
 i := 0;
 while (i<Length(Liens)) and (Liens[i, 0]<>iMot)do inc(i);
 if i<Length(Liens) then chercheTab := i;
end;
 
procedure TForm1.Lier(iMot, iLien: integer);
var k : integer;
begin
  k := chercheTab(iMot);
  if k < 0 then
  begin
     SetLength(Liens, Length(Liens)+1); //extension du tableau principal
     k := Length(Liens)-1;
     SetLength(Liens[k], 1);
     Liens[k][0] := iMot; //identifiant
     k := PlaceTab(k);    //nouvel emplacement
     Inc(nLiens); //mise à jour du nombre de mots liés
     Caption := 'Lex6 '+IntToStr(nMots)+ ' mots dont '
                       +IntToStr(nLiens) + ' liés';
  end;
  SetLength(Liens[k], Length(Liens[k])+1);  //extension du tableau secondaire
  Liens[k, Length(Liens[k])-1] := iLien;  // lien
  PlaceLien(k);                           //tri
end;
 
procedure TForm1.AffLiens;
var i, k : integer;
begin
 if Length(Liens)>0 then
 begin
   ListBox1.Clear;
   k := chercheTab(iMot);
   if k>=0 then
     for i :=1 to Length(Liens[k]) -1 do
       ListBox1.Items.Add(AnsiToUTF8(listeMots[Liens[k, i]]));
   ListBox2.Items := ListBox1.Items;
 end;
end;
 
function TForm1.TriSec(k: integer): boolean;
var i, Tamp : integer;
begin
  TriSec := True;
  for i := Length(Liens[k]) - 1 downto 2 do
    if Liens[k, i] < Liens[k, i-1] then
    begin
      Tamp :=  Liens[k, i];
      Liens[k, i] := Liens[k, i-1];
      Liens[k, i-1] := Tamp;
      TriSec := False;
    end;
end;
 
function TForm1.TriPPal: boolean;
var i : integer;
    Tamp : Array of integer;
begin
  TriPPal := True;
  for i := Length(Liens) - 1 downto 1 do
    if Liens[i, 0] < Liens[i-1, 0] then
    begin
      Tamp :=  Liens[i];
      Liens[i] := Liens[i-1];
      Liens[i-1] := Tamp;
      TriPPal := False;
    end;
end;
 
procedure TForm1.PlaceLien(k: integer);
var i, Tamp : integer;
begin
 i := Length(Liens[k]) - 1;
 while (Liens[k, i] < Liens[k, i-1]) and (i>1)  do
 begin
      Tamp :=  Liens[k, i];
      Liens[k, i] := Liens[k, i-1];
      Liens[k, i-1] := Tamp;
      Dec(i);
 end;
end;
 
function TForm1.PlaceTab(k: integer): integer;
var i : integer;
    Tamp : Array of integer;
begin
 i := k;
 while (Liens[i, 0] < Liens[i-1, 0]) and (i>1)  do
    begin
      Tamp :=  Liens[i];
      Liens[i] := Liens[i-1];
      Liens[i-1] := Tamp;
      dec(i);
    end;
 PlaceTab := i;
end;
 
function TForm1.SansAccent(rMot: string): string;
var i, j : integer;
    cAcc, sAcc : string;
begin
 cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
 //regroupe tous les caractères à remplacer
 sAcc := 'aaaeeeeiiouuuyc';
 //regroupe tous les caractères de substitution
 SansAccent := '';
 rMot := LowerCase(rMot);
 for i:=1 to Length(rMot) do
   begin
     j := Pos(rMot[i], cAcc);
     case j of
       0      :  SansAccent := SansAccent + rMot[i];
       1..15 : SansAccent := SansAccent + sAcc[j];
     end;
   end;
end;
 
procedure TForm1.listeApprox(rechMot: string);
var i, k : integer;
    referMot, testMot : string;
    begin
     SetLength(tabApprox, 0);   //mise à zéro du tableau
     referMot := SansAccent(rechMot);
     if referMot>'' then
     begin
        //point de démarrage de la recherche : première lettre du mot
        i := 0;
        while SansAccent(listeMots[i][1]) < referMot[1] do inc(i);
        //début de la recherche
        repeat
          if SansAccent(listeMots[i]) = referMot then
          begin
             listBox3.Items.Append(AnsiToUTF8(listeMots[i]));
             //enregistrement des index pour réutilisation
             SetLength(tabApprox, Length(tabApprox)+1);
             tabApprox[Length(tabApprox)-1] := i;
          end;
          inc(i)
        until (i>nMots-1) or (SansAccent(listeMots[i][1]) > referMot[1]);
       //la première lettre a changé
    end;
end;
procedure TForm1.MAJSupp;
begin
  Label5.Caption := Label2.Caption;
  ListBox4.Items := ListBox2.Items;
  Label6.Caption:= '';
  Button6.Enabled:= False;
end;
 
procedure TForm1.SuppLien(iMot, iLien: integer);
var i, k : integer;
begin
//dans le tableau secondaire de iMot, on supprime iLien
  k := chercheTab(iMot);
  i:=1;
  while Liens[k, i]<> iLien do inc(i);
  while (i<Length(Liens[k])-1) do
  begin
     Liens[k, i] :=  Liens[k, i+1];
     inc(i);
  end;
  SetLength(Liens[k], Length(Liens[k]) - 1);
  if (Length(Liens[k]) = 1) then  //le mot n'a plus de lien
  begin
     for i := k to Length(Liens)-2 do
         Liens[i] := Liens[i+1];
     SetLength(Liens, Length(Liens)-1);
     nLiens := Length(Liens);
  end;
  MAJBalayage;
end;
 
 
procedure TForm1.TrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   iMot := Round(TrackBar1.Position*nMots/1000);
   iMot := (iMot + nMots) mod  nMots;
   MAJBalayage;
end;
 
 
procedure TForm1.Recherche(rechMot: string);
var irechMot : integer;
begin
 listBox3.Clear;
 irechMot := listeMots.IndexOf(rechMot);
 if irechMot >= 0 then
  begin
    Label1.Caption:= AnsiToUTF8(listeMots[irechMot]);
    iMot := irechMot;
    MAJBalayage;
  end
  else
  begin
    Label1.Caption:= 'échec';
    listeApprox(rechMot);
  end;
end; 
 
 
 
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
   if Button=btNext then Inc(iMot)
                       else Dec(iMot);
   iMot := iMot + nMots   mod  nMots;
   MAJAffichage;
end;
 
procedure TForm1.MAJAffichage;
begin
   Label1.Caption:=AnsiToUTF8(listeMots[iMot]);
   Edit2.Caption:= '';
   Memo1.Append('Index '+IntToStr(iMot));
end;
 
end.
précédentsommairesuivant
(19)
Le processus utilisé est le plus simple, mais pas le plus rapide.
(20)
Les mots qui apparaissent dans le Memo peuvent comporter des caractères insolites en remplacement de caractères accentués : il suffit de rajouter la fonction AnsiToUTF8 dans la procédure d'affichage pour que tout rentre dans l'ordre.
(21)
Et la plupart des jeux de lettres.
(22)
En lettres majuscules dans les jeux.
(23)
Voir la création de la procédure ListBox2Click ci-dessus

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2014 dimanche2003. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.