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

GENÈSE D'UN DICTIONNAIRE

Construction d'un lexique interactif avec Lazarus


précédentsommairesuivant

Recherche logique

Introduction

L'outil Masque développé dans le chapitre précédent présente une utilité certaine pour le joueur de mots croisés qui connaît une ou des lettres du mot à trouver.

Dans le cas contraire, le joueur ne dispose que de la définition de ce mot, définition souvent piégée par les ambiguïtés de la langue.

Dans ce chapitre, nous allons aborder cet aspect culturel ou humoristique du vocabulaire en utilisant les liens déjà disponibles.

Et nous pourrons vérifier que… ça marche !

Environnement

Chapitre 10…

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

  • ouvrir pLex9.lpi dans Lex10 avec Lazarus ;
  • enregistrer uLex9.pas sous le nom de uLex10.pas ;
  • accepter la suppression des références à uLex9.pas ;
  • enregistrer pLex9.pas sous le nom de pLex10.pas ;
  • renommer la fenêtre Lex9 en Lex10 ;
  • dans le répertoire Lex10, supprimer les anciens fichiers contenant la mention Lex9 ;
  • dans la procédure MAJBalayage, remplacer Lex9 par Lex10.

Les fichiers de données (mots et liens) peuvent être téléchargés à l'aide du lien inclus dans le chapitre 9.

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

Humour

La recherche d'un mot peut s'effectuer dans l'onglet Balayage : le curseur permet de parcourir aisément notre liste de mots par un simple déplacement de la souris ; les flèches droite et gauche autorisent un déplacement d'une unité, ou davantage en jouant avec le zoom.

La zone de saisie - dans le même onglet - et un clic sur le bouton  (flèche vers le haut) permettent de découvrir si le mot saisi existe ou non, avec affichage de mots proches éventuels.

La recherche peut aussi s'effectuer à partir de l'onglet Masque, qui permet de préciser la longueur du mot et la position des lettres connues.

Recherches élémentaires, mon cher Watson…

En effet, les jeux de mots croisés apportent des informations plus complexes dans le cadre de « définitions » souvent ambiguës où l'humour sous-jacent révèle le talent de l'auteur… mais seulement quand la solution apparaît !

C'est là que les liens dont nous avons entamé la construction vont montrer leur intérêt.

Interface graphique

L'onglet Logique est encore vide.

Pour faciliter la compréhension du code, nous allons prendre la peine, dans ce chapitre, de renommer l'onglet, ainsi que les composants que nous y insérerons. Chacun pourra apprécier ainsi l'intérêt de cette méthode qui reste facultative.

Pour Lazarus, l'onglet Logique apparaît sous le nom générique de TabSheet7(36). Dans sa propriété Name, nous remplaçons ce nom par tabLogique.

Image non disponible

Ensuite, nous insérons cinq composants que nous renommons et définissons ainsi :

Image non disponible

  • un label, renommé en labReq, caption porté à « Requête », Font/Size portée à 14 ;
  • un bouton, renommé en boutFH, caption porté(37) à « ⇪ » qui correspond au code utf8 $E2$87$AA ; taille fixée à 14 ; largeur (Width) ramenée à 25 ;
  • un edit, renommé edReq, code couleur $00BBFFFD ;
  • un second bouton, renommé boutReq ; caption porté à « Chercher », largeur 100 ;
  • un ListBox, renommé lisReq, même couleur de fond que edReq.

L'ensemble est remanié à l'aide de la souris pour obtenir sensiblement ceci :

Image non disponible

Le choix des teintes est éminemment subjectif, et chacun peut évidemment apporter sa touche personnelle.
En ce qui concerne l'espace vide à droite de l'onglet, nous le réservons pour un usage ultérieur.

Méthode

Notre idée est d'afficher tous les mots liés aux mots saisis.

Deux aspects sont à prendre en compte : la fréquence des occurrences et la profondeur de la recherche.

Fréquence

La première fois qu'un mot apparaît dans les liens, nous notons sa référence (indice du mot ou position dans la liste principale) et complétons mentalement cette note par le chiffre 1 qui indique que c'est la première fois qu'il est enregistré.

La seconde fois, la fréquence sera incrémentée de une unité, ainsi de suite.

Ainsi, les liens obtenus peuvent être affichés par ordre de fréquence décroissante, de façon à orienter en priorité l'utilisateur vers la ou les réponses les plus pertinentes. C'est cette méthode qu'ont retenue les moteurs de recherche habituels.

En ce qui nous concerne, l'intérêt de la fréquence est limité dans la mesure où une définition de mot croisé fait appel à une notion accessoire, un sens secondaire : c'est précisément ce côté subalterne, minoritaire, que nous devons saisir. Nous ne tiendrons donc pas compte ici du paramètre fréquence.

Les plus courageux pourront néanmoins créer la variable globale
tabOccur : Array of Array[0..1] of integer;
La première partie de chaque élément (tabOccur[i,0]) recevra l'indice du mot, et la seconde partie (tabOccur[i,1]) recevra la fréquence.
La variable est un tableau dynamique… qu'il faudra initialiser.

Profondeur

Le niveau 1 de la recherche consiste à établir la liste des mots directement liés aux mots-clés de départ : cette liste contient normalement des mots nouveaux qui orientent l'utilisateur vers des horizons différents.

Que se passe-t-il si la recherche est relancée à partir de ce stade ? Les horizons nouveaux ouvrent de nouvelles perspectives, etc.

Mais il est évident qu'un nombre trop élevé de recherches successives aboutirait à un brouillage contre-productif.

Avec une entrée de deux mots-clés, nous obtenons, par exemple, les nombres d'occurrences suivants(38) :

Profondeur 0 1 2 3
N. occurrences 2 4 33 119

Nous nous limiterons ici à un niveau 2, c'est-à-dire que nous réutiliserons une fois les résultats obtenus après la première recherche.

Comme la notion de fréquence n'a pas été retenue, nous disposerons ainsi d'une liste totalement indifférenciée(39) dans laquelle l'utilisateur pourra faire son choix.

Variables

Chaque mot saisi est versé, après un clic sur le bouton , dans la ligne de requête. Nous stockerons les indices (places de chaque mot dans la liste principale) dans une variable constituée par un tableau dynamique d'entiers.

Parmi les variables globales disponibles, nous trouvons déjà la variable tabApprox, qui correspond à un tableau dynamique d'entiers. Nous ajoutons la variable tabReq qui recevra les indices de nos requêtes.

Pour les réponses, nous avons besoin d'un autre tableau dynamique qui stockera l'indice de ces mots. Nous ajoutons dans la liste des variables globales la variable tabOccur :

 
Sélectionnez
var
  Form1: TForm1;
  listeMots, listeInfo : TstringList;
  iMot, nMots, nLiens, iLien : integer;
  AffListe : TListBox;
  Liens : Array of Array of integer;
  tabApprox, tabReq, tabOccur : Array of integer;
  sAcc, cAcc : string;

Nous avons déjà rencontré les tableaux dynamiques : ils doivent faire l'objet d'une initialisation.

Initialisation

L'onglet Logique doit être préparé pour la première saisie dès que l'utilisateur aura décidé de l'afficher.

Nous utiliserons donc la procédure OnShow de l'onglet.

Pour cela, nous sélectionnons l'onglet dans l'inspecteur d'objets (ici la ligne TabSheet7) et au-dessous, dans l'onglet Événements, nous cliquons sur les trois points qui terminent la ligne OnShow.

Le curseur clignote dans l'éditeur de source entre les mots begin et end de la procédure TabSheet7Show que nous complétons ainsi :

 
Sélectionnez
procedure TForm1.tabLogiqueShow(Sender: TObject);
begin
  Edit1.Clear;
  ListBox5.Clear;
  Label3.Caption:= 'Requête ';
  SetLength(tabReq, 0);
  SetLength(tabOccur, 0);
end;

Les composants sont nettoyés, les deux tableaux dynamiques initialisés.

Logiquement, nous procédons de même pour l'événement OnExit :

 
Sélectionnez
procedure TForm1.tabLogiqueExit(Sender: TObject);  
begin
 SetLength(tabReq, 0);
 SetLength(tabOccur, 0);
end;

De cette façon, nos deux variables globales auront entièrement libéré l'espace mémoire lorsque l'utilisateur quittera l'onglet.

Requête

L'entrée d'un mot se fait naturellement par la zone de saisie et le clic sur le bouton . Si le mot existe, il bascule dans la ligne de requête et son indice est stocké dans la table tabReq :

 
Sélectionnez
procedure TForm1.boutFHClick(Sender: TObject); 
var i, j, k : integer;
  begin
    //ajoute un mot à la liste de base tabReq
    i := listeMots.IndexOf(UTF8ToAnsi(Edit1.Caption));
    if i>=0 then //le mot existe dans la liste principale
    begin
       j:=0;
       k := Length(tabReq);
       while (j<k) and (i<>tabReq[j]) do inc(j);
       if j=k then      //le mot peut être ajouté
       begin
         SetLength(tabReq, k+1); //ajoute une unité au tableau
         tabReq[k] := i;
         //affichage de la requête dans la ligne titre
         if labReq.Caption = 'Requête ' then
            labReq.Caption:= edReq.Caption //premier mot-clé
            else
            labReq.Caption:= labReq.Caption +' + '+edReq.Caption;
       end;
    end;
    edReq.Clear;
  end;

Un premier contrôle vérifie que le mot existe déjà dans la liste principale ; le second évite de saisir un doublon qui alourdirait inutilement la requête.

Au premier affichage, le mot saisi remplace le mot « Requête ».

La requête peut être complétée à volonté : chaque nouveau mot est ajouté au précédent, séparé par le signe +.

Recherche

Nous avons fixé la profondeur de recherche à 2 : ce sera la valeur de la constante profRech déclarée en premier.

La variable j balaye le tableau des liens jusqu'à l'indice du mot-clé : si celui-ci dispose de liens, ils sont stockés dans la variable tabOccur par l'intermédiaire de la procédure(40) AjoutOccur, qui s'assure de ne pas enregistrer de doublons :

 
Sélectionnez
procedure TForm1.AjoutOccur(iOccur: integer);
var i : integer;
begin
         //vérifier que cette occurrence n'a pas encore été rencontrée
         i:=0;
         while (i<Length(tabOccur)) and (iOccur<> tabOccur[i])  do inc(i);
         if i= Length(tabOccur) then   //première occurrence du mot
         begin
           SetLength(tabOccur, i+1);
           tabOccur[i] := iOccur;
         end;
end;

Un clic sur le bouton Chercher déclenche pour commencer une vérification sur la longueur de la requête, qui ne doit pas être vide.

À la fin de la première recherche, les occurrences obtenues sont basculées dans la variable tabReq, qui constituera la nouvelle base de la recherche ; le tableau tabOccur est remis à zéro au début de la seconde recherche(41).

 
Sélectionnez
procedure TForm1.boutReqClick(Sender: TObject); 
const profRech = 2;      //fixe la profondeur de la recherche
var i, j, k, n : integer;
begin
 if Length(tabReq)>0 then //la requête ne doit pas être vide
 begin
   for n := 1 to profRech do
     begin
       SetLength(tabOccur, 0);
       for i:=0 to Length(tabReq)-1 do
           begin
             j := 0;
             while (j<Length(Liens)) and (Liens[j, 0]<>tabReq[i])do inc(j);
             if j<Length(Liens) then
             for k:=1 to Length(Liens[j])-1 do AjoutOccur(Liens[j, k]);
           end;
       tabReq := tabOccur;
     end;
     j := Length(tabOccur);
     //afficher les occurrences et leur nombre
     lisReq.Items.Append(IntToStr(j)+' occurrences : ');
     TriOccur; //trier avant affichage
     for i:=0 to j-1 do
       lisReq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
 end;
end;

En fin de recherche, les mots trouvés sont affichés avec, en tête, l'indication de leur nombre. Pour apporter un peu de clarté, les mots sont triés par la procédure TriOccur. Nous avons déjà vu comment déclarer et créer une nouvelle procédure.

 
Sélectionnez
procedure TForm1.TriOccur;
var i, j, occTampon : integer ;
  triOK : boolean;
begin
 i := 0;
 j := Length(tabOccur)-2;
 triOK := True;
 repeat
    if (tabOccur[i] >  tabOccur[i+1])  then
    begin
      occTampon := tabOccur[i];
      tabOccur[i] := tabOccur[i+1];
      tabOccur[i+1] := occTampon;T
      triOK := False;
    end;
    inc(i);
    if not triOK and (i>j) then
    begin
      i:=0; //nouvelle passe de permutations
      triOK:= True;
    end;
 until triOK and (i>j);
end;

Application

Nous allons utiliser nos nouveaux outils.

Dans le premier chapitre, nous avions évoqué l'énigme présentée par Tristan Bernard : « vide les baignoires et remplit les lavabos ». Les deux mots-clés sont à l'évidence « baignoire » et « lavabo » : nous les entrons l'un après l'autre à l'aide du bouton .

Un clic sur le bouton Chercher nous donne ceci :

Image non disponible

À ce stade, il est bien difficile de conclure à la réussite ou à l'échec de notre requête…

Complément d'information

Le cruciverbiste dispose, en plus de la définition d'un mot, d'une grille qui indique le nombre de lettres de ce mot, et précise, s'il a de la chance, quelques lettres déjà obtenues par croisement.

Nous revenons ici au principe de l'outil Masque, qui est déjà disponible dans l'onglet précédent. Nous pourrions dupliquer la liste des réponses dans cet onglet, et laisser l'initiative à l'utilisateur.

Il nous a semblé plus ergonomique de dupliquer l'onglet Masque dans notre onglet Logique.

Nous ajoutons donc quatre composants supplémentaires que nous renommons et arrangeons ainsi :

Image non disponible

  1. Le Label7, renommé labMasq, rappelle qu'il faut saisir les lettres connues séparées par le signe « $ » ;
  2. un Edit, renommé edMasq, qui recevra les indications de l'utilisateur, couleur $00F4ECFF ;
  3. un bouton renommé boutMasq, Caption « Masque », qui déclenche une procédure directement inspirée de celle qui a été mise en œuvre dans l'onglet précédent, la différence portant sur le champ de recherche : ici, la liste de mots est limitée aux occurrences déjà affichées ;
  4. un listBox, renommé lisMasq, couleur $00F4ECFF.

Le code peut s'écrire ainsi :

 
Sélectionnez
procedure TForm1.boutMasqClick(Sender: TObject);    
var i, j, k : integer;
    motCour, sMasque : string;
begin
  i := 0;
  sMasque := edMasq.Caption;
  k := Length(sMasque);
  lisMasq.Clear;
  repeat
    motCour := SansAccent(listeMots[tabOccur[i]]);
    if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
    begin
      j := 1;
      while (j<=k) and ((sMasque[j]='$') or (sMasque[j] = motCour[j])) do inc(j);
      if j>k  then                             lisMasq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
    end;
    inc(i);
  until (i=Length(tabOccur));
end;

Pour en simplifier l'utilisation, nous cachons les outils de masque tant que la requête n'est pas effectuée. La procédure onShow de l'onglet doit donc faire l'objet d'un complément :

 
Sélectionnez
procedure TForm1.tabLogiqueShow(Sender: TObject);
begin
  edReq.Clear;
  lisReq.Clear;
  labReq.Caption:= 'Requête ';
  labMasq.Caption := 'saisir les lettres séparées'+#13+' par le signe $';
  boutMasq.Enabled:=False;
  edMasq.Clear;
  edMasq.Visible:=False;
  labMasq.Visible:=False;
  lisMasq.Visible:=False;
  SetLength(tabReq, 0);
  SetLength(tabOccur, 0);
end;

Mais en fin de requête, les outils doivent apparaître : la procédure Button5Click est modifiée ainsi :

 
Sélectionnez
procedure TForm1.boutReqClick(Sender: TObject);
const profRech = 2;      //fixe la profondeur de la recherche
var i, j, k, n : integer;
  begin
   if Length(tabReq)>0 then //la requête ne doit pas être vide
   begin
     for n := 1 to profRech do
       begin
         SetLength(tabOccur, 0);
         for i:=0 to Length(tabReq)-1 do
             begin
               j := 0;
               while (j<Length(Liens)) and (Liens[j, 0]<>tabReq[i])do inc(j);
               if j<Length(Liens) then
               for k:=1 to Length(Liens[j])-1 do AjoutOccur(Liens[j, k]);
             end;
         tabReq := tabOccur;
       end;
       j := Length(tabOccur);
       //afficher les occurrences et leur nombre
       lisReq.Items.Append(IntToStr(j)+' occurrences : ');
       TriOccur; //trier avant affichage
       for i:=0 to j-1 do
         lisReq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
   end;
   edMasq.Clear;
   edMasq.Visible:=True;
   labMasq.Visible:=True;
   lisMasq.Visible:=True;
   boutMasq.Enabled:=True;
end;

Pour notre énigme, nous connaissons au minimum la longueur de la réponse, soit huit lettres.

Nous rédigeons à nouveau la requête « baignoire + lavabo », précisons la longueur du mot, soit 8 fois le signe « $ » dans le TEdit, et nous obtenons ceci après un clic sur le bouton Masque :

Image non disponible

La bonne réponse est bien sûr l'entracte, qui vide les baignoires et remplit les lavabos !

Interprétation

Une telle requête présentée sur les moteurs de recherche habituels aboutit à des résultats… décourageants.

Par exemple, avec Google, nous obtenons 3 700 000 réponses en 0,27 seconde, mais ce sont des informations essentiellement commerciales, donc sans intérêt dans les circonstances qui nous intéressent.

Image non disponible

Or nous venons d'obtenir deux réponses(42), dont une correcte, ce qui constitue, a priori, une performance hautement improbable. Notre application mérite donc une petite analyse critique.

Le mécanisme des sélections et des tris que nous avons mis en œuvre est incontestable : il peut être réutilisé et donnera toujours les mêmes résultats.

Voyons alors comment s'est opérée la saisie des liens.

Liens du premier niveau

Un mot-clé est « baignoire » : si ce mot est entré dans l'onglet Liens, notre logiciel affiche les résultats suivants :

Image non disponible

L'autre mot-clé est « lavabo ». L'affichage donne ceci :

Image non disponible

Au total, le premier niveau de recherche propose quatre mots, ce qui est bien maigre. La répétition du mot « toilette » n'apporte aucune information supplémentaire, puisque le paramètre fréquence n'entre pas en jeu.

Deuxième niveau

Que se passe-t-il lors de la recherche du second niveau ? Nous voyons déjà que le mot « baignoire » est associé au mot « théâtre » (une baignoire est une sorte de loge). Les liens disponibles sur ce mot sont nombreux(43) :

Image non disponible

Et là, nous voyons apparaître, comme par magie, le mot « entracte » qui est précisément le mot cherché !

Deux recherches successives ont suffi, mais il n'est pas exclu qu'il faille aller plus loin dans certains cas.

Les indices manquants sont fournis sur la grille (longueur du mot) et, éventuellement par les lettres déjà identifiées sur la grille.

Conclusion

Avec seulement 5 000 mots liés, notre base de données est déjà capable de fournir des résultats intéressants. Et au fur et à mesure que ce nombre augmentera, les résultats seront de plus en plus pertinents : ainsi, chacun pourra se constituer sa base personnelle… et en faire profiter ses amis !

Notre projet est maintenant terminé, l'objectif est atteint.

Nous verrons, dans le prochain chapitre, quelques améliorations techniques telles que la fusion des fichiers de mots et de liens et la création d'une fenêtre de sélection. Ensuite pourront être abordés les sujets les plus fréquemment évoqués par les amateurs de mots croisés et… de Lazarus.

Amour : Mot en cinq lettres, trois voyelles, deux consonnes et deux idiots .
Ambrose Bierce

Le code de l'unité uDisque n'a pas changé.

Celui de l'unité uLex10 se présente maintenant ainsi :

 
Sélectionnez
unit ulex10;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls,
  Graphics, Dialogs, StdCtrls, ComCtrls, uDisque;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button10: TButton;
    Button2: TButton;
    Button3: TButton;
    boutFH: TButton;
    boutReq: TButton;
    boutMasq: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    CheckBox1: TCheckBox;
    edMasq: TEdit;
    edReq: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    labMasq: TLabel;
    labReq: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    ListBox4: TListBox;
    lisReq: TListBox;
    lisMasq: TListBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    tabLogique: TTabSheet;
    Zoom: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    AffListe: TListBox;
    PageControl1: TPageControl;
    Page1: TTabSheet;
    TabSheet1: TTabSheet;
    TrackBar1: TTrackBar;
    UpDown2: TUpDown;
    procedure AffListeClick(Sender: TObject);
    procedure boutFHClick(Sender: TObject);
    procedure boutMasqClick(Sender: TObject);
    procedure boutReqClick(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(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 tabLogiqueExit(Sender: TObject);
    procedure tabLogiqueShow(Sender: TObject);
    procedure TabSheet1Show(Sender: TObject);
    procedure TabSheet3Show(Sender: TObject);
    procedure TabSheet4Show(Sender: TObject);
    procedure TabSheet5Show(Sender: TObject);
    procedure TrackBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    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;
    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);
    function fMotNouv(rechMot : string) : integer;
    function fAnnonceMotNouveau(motNouv : string) : integer;
    procedure AjoutMot(motNouv : string; indexMotNouv : integer);
    procedure AjoutMotSecur(motNouv : string ; indexMotNouv : integer);
    procedure SupMot(motCour : string; indexMotCour : integer);
    function fDoublon(iMot, iLien: integer): boolean;
    procedure Masque(rechMot: string);
    procedure AjoutOccur(iOccur : integer);
    procedure TriOccur;

  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, tabReq, tabOccur : Array of integer;  //index des mots approchants  &#8682;   utf8 $E2$87$AA flèche haut
  sAcc, cAcc : string;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
 regLiens;
 regFichier(listeMots);
 listeMots.Free;
 Application.Terminate;
end;

procedure TForm1.AffListeClick(Sender: TObject);
begin
   iMot := (iMot -delta + AffListe.ItemIndex + nMots) mod nMots;
   MAJBalayage;
end;

procedure TForm1.boutFHClick(Sender: TObject);
var i, j, k : integer;
  begin
    //ajoute un mot à la liste de base tabReq
    i := listeMots.IndexOf(UTF8ToAnsi(edReq.Caption));
    if i>=0 then //le mot existe dans la liste principale
    begin
       j:=0;
       k := Length(tabReq);
       while (j<k) and (i<>tabReq[j]) do inc(j);
       if j=k then      //le mot peut être ajouté
       begin
         SetLength(tabReq, k+1); //ajoute une unité au tableau
         tabReq[k] := i;
         //affichage de la requête dans la ligne titre
         if labReq.Caption = 'Requête ' then
            labReq.Caption:= edReq.Caption //premier mot-clé
            else
            labReq.Caption:= labReq.Caption +' + '+edReq.Caption;
       end;
    end;
    edReq.Clear;
  end;

procedure TForm1.boutMasqClick(Sender: TObject);
var i, j, k : integer;
    motCour, sMasque : string;
begin
  i := 0;
  sMasque := edMasq.Caption;
  k := Length(sMasque);
  lisMasq.Clear;
  repeat
    motCour := SansAccent(listeMots[tabOccur[i]]);
    if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
    begin
      j := 1;
      while (j<=k) and ((sMasque[j]='$') or (sMasque[j] = motCour[j])) do inc(j);
      if j>k  then lisMasq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
    end;
    inc(i);
  until (i=Length(tabOccur));
end;


procedure TForm1.boutReqClick(Sender: TObject);
const profRech = 2;      //fixe la profondeur de la recherche
var i, j, k, n : integer;
  begin
   if Length(tabReq)>0 then //la requête ne doit pas être vide
   begin
     for n := 1 to profRech do
       begin
         SetLength(tabOccur, 0);
         for i:=0 to Length(tabReq)-1 do
             begin
               j := 0;
               while (j<Length(Liens)) and (Liens[j, 0]<>tabReq[i])do inc(j);
               if j<Length(Liens) then
               for k:=1 to Length(Liens[j])-1 do AjoutOccur(Liens[j, k]);
             end;
         tabReq := tabOccur;
       end;
       j := Length(tabOccur);
       //afficher les occurrences et leur nombre
       lisReq.Items.Append(IntToStr(j)+' occurrences : ');
       TriOccur; //trier avant affichage
       for i:=0 to j-1 do
         lisReq.Items.Append(AnsiToUTF8(listeMots[tabOccur[i]]));
   end;
   edMasq.Clear;
   edMasq.Visible:=True;
   labMasq.Visible:=True;
   lisMasq.Visible:=True;
   boutMasq.Enabled:=True;
end;


procedure TForm1.Button10Click(Sender: TObject);
var iLien : integer;
    motNouv : string;
begin
     if Edit3.Caption > #47 then
     begin
       motNouv := UTF8ToAnsi(Edit3.Caption);
       iLien := listeMots.IndexOf(motNouv);
       if iLien<0 then  iLien := fAnnonceMotNouveau(motNouv);
       if (iLien>=0) and  (iLien<>iMot) and not fDoublon(iMot, iLien) then
       begin
           Label4.Caption:= Edit3.Caption;
           iMot := iLien;
       end;
       AffLiens;
     end
     else ShowMessage('Entrez le mot');
     Edit3.Clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   //Recherche(UTF8ToAnsi(Edit2.Caption));
   ListBox3.Clear;
   Masque(SansAccent(UTF8ToAnsi(Edit2.Caption)));
end;


function TForm1.fMotNouv(rechMot: string): integer;
var i, k : integer;
    referMot : string;
begin
      SetLength(tabApprox, 0);   //mise à zéro du tableau
      referMot := SansAccent(rechMot);
      //point de démarrage de la recherche : première lettre du mot
      i := 0;
      k := 0;
      while SansAccent(listeMots[i][1]) < referMot[1] do inc(i);
      //début de la recherche
      repeat
        //k index futur du mot nouveau
        if (k=0) and (SansAccent(listeMots[i]) > referMot) then  k := i
        else if SansAccent(listeMots[i]) = referMot then
        begin
           //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]);
      if k=0 then fMotNouv := nMots else fMotNouv := k;
end;

//==========================
function TForm1.fAnnonceMotNouveau(motNouv: string): integer;
 var i, indexMotNouv  : integer;
     Rep : string;
 begin
    if listeMots.IndexOf(motNouv)<0 then
    begin
        indexMotNouv := fMotNouv(motNouv);
        Rep := 'Ajouter le mot '+ AnsiToUTF8(motNouv) +' ? ';
        if Length(tabApprox)>0  then  //affichage des mots proches éventuels
        begin
          Rep := Rep +#13#10 + 'Mots existants : ';
          For i:=0 to Length(tabApprox) - 1 do
            Rep := Rep + ANSIToUTF8(listeMots[tabApprox[i]])+' /';
        end;
        if MessageDlg ('Mot nouveau', Rep, mtConfirmation,
                         [mbYes, mbNo],0) = mrYes
        then
        begin
          AjoutMot(motNouv, indexMotNouv);
          fAnnonceMotNouveau := indexMotNouv;
        end
        else fAnnonceMotNouveau := -1;
    end;
 end;

procedure TForm1.AjoutMot(motNouv: string; indexMotNouv: integer);
var   nouvLiens : array of array of integer;
      i, j : integer;
begin
   nouvLiens := Liens;
   for i:=0 to Length(Liens)-1 do
     for j:=0 to Length(Liens[i])-1 do
       if Liens[i, j]>= indexMotNouv then inc(Liens[i, j]);
   if iMot >= indexMotNouv then inc(iMot);                     //mise à jour effectuée
   SetLength(nouvLiens, 0);
   listeMots.Insert(indexMotNouv, motNouv); //modification de la liste principale
   inc(nMots);
end;
//===========doublons=======================
function TForm1.fDoublon(iMot, iLien: integer): boolean;
var i, j : integer;
begin
  //vérifie que le lien n'existe pas déjà
  //cherche le tableau de liens correspondant à iMot
  fDoublon := False;
  j := chercheTab(iMot);
  if j>=0 then
  begin
    i := Length(Liens[j])-1;
    while (i>0) and (iLien<Liens[j, i]) do dec(i);
    if iLien = Liens[j, i] then fDoublon := True;
    if fDoublon then ShowMessage('Doublon refusé');
  end;
end;

procedure TForm1.Masque(rechMot: string);
var i, j, k : integer;
    motCour : string;
begin
  i := 0;
  k := Length(rechMot);
  Label1.Caption:= ('Mot de ' + IntToStr(k)+ ' lettres' );
  ListBox3.Clear;
  repeat
    motCour := SansAccent(listeMots[i]);
    if Length(motCour) = k then  //balayage du mot pour comparaison des lettres
    begin
      j := 1;

      while (j<=k) and ((rechMot[j]='$') or (rechMot[j] = motCour[j])) do inc(j);
      if j>k  then ListBox3.Items.Append(AnsiToUTF8(listeMots[i]));
    end;
    inc(i);
  until (i=nMots) or ((rechMot[1]='$') and (rechMot[1] > motCour[1]));
  //balayage tant que la première lettre est inférieure à celle du masque
  if ListBox3.Count=0 then Label1.Caption:= ('échec')
                      else Label1.Caption:= (IntToStr(ListBox3.Count)+
                                             ' mots trouvés');
end;

procedure TForm1.AjoutOccur(iOccur: integer);
var i : integer;
begin
         //vérifier que cette occurrence n'a pas encore été rencontrée
         i:=0;
         while (i<Length(tabOccur)) and (iOccur<> tabOccur[i])  do inc(i);
         if i= Length(tabOccur) then   //première occurrence du mot
         begin
           SetLength(tabOccur, i+1);
           tabOccur[i] := iOccur;
         end;
end;

procedure TForm1.TriOccur;
var i, j, occTampon : integer ;
  triOK : boolean;
begin
 i := 0;
 j := Length(tabOccur)-2;
 triOK := True;
 repeat
    if (tabOccur[i] >  tabOccur[i+1])  then
    begin
      occTampon := tabOccur[i];
      tabOccur[i] := tabOccur[i+1];
      tabOccur[i+1] := occTampon;
      triOK := False;
    end;
    inc(i);
    if not triOK and (i>j) then
    begin
      i:=0; //nouvelle passe de permutations
      triOK:= True;
    end;
 until triOK and (i>j);
end;


procedure TForm1.AjoutMotSecur(motNouv: string; indexMotNouv: integer);
var  nouvLiens : array of array of integer;
      i, j : integer;
begin
   SetLength(nouvLiens, Length(Liens));
   for i:=0 to Length(Liens)-1 do
     begin
       SetLength(nouvLiens[i], Length(Liens[i]));
       for j:=0 to Length(Liens[i])-1 do
         if Liens[i, j]>= indexMotNouv then nouvLiens[i, j] := Liens[i, j] + 1
         else nouvLiens[i, j] := Liens[i, j];
     end;
   Liens := nouvLiens;   //mise à jour effectuée
   if iMot >= indexMotNouv then inc(iMot);
   listeMots.Insert(indexMotNouv, motNouv); //modification de la liste principale
   inc(nMots);
end;

//==============================

procedure TForm1.SupMot(motCour: string; indexMotCour: integer);
var  nouvLiens : array of array of integer;
     i, j : integer;
begin
   SetLength(nouvLiens, Length(Liens));
   for i:=0 to Length(nouvLiens)-1 do
     begin
       SetLength(nouvLiens[i], Length(Liens[i]));
       for j:=0 to Length(nouvLiens[i])-1 do
         if Liens[i, j]>= indexMotCour then nouvLiens[i, j] := Liens[i, j] - 1
         else  nouvLiens[i, j] := Liens[i, j];
     end;
   if iMot >= indexMotCour then dec(iMot);
   Liens := nouvLiens;
   //mise à jour effectuée
   listeMots.Delete(indexMotCour);        //modification de la liste principale
   dec(nMots);
end;


procedure TForm1.Button3Click(Sender: TObject);
var iLien : integer;
    motNouv : string;
begin
     if Edit3.Caption > #47 then
     begin
       motNouv := UTF8ToAnsi(Edit3.Caption);
       iLien := listeMots.IndexOf(motNouv);
       if iLien<0 then  iLien := fAnnonceMotNouveau(motNouv);
       if (iLien>=0) and  (iLien<>iMot) and not fDoublon(iMot, iLien) then
       begin
           Lier(iMot, iLien);
           Lier(iLien, iMot);
       end;
       AffLiens;
     end
     else ShowMessage('Entrez le mot');
     Edit3.Clear;
end;




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

//=================
procedure TForm1.Button7Click(Sender: TObject);
var i  : integer;
    motNouv : string;
begin
   motNouv := UTF8ToAnsi(Edit4.Caption);
   i := listeMots.IndexOf(motNouv);
   if (i >= 0) then ShowMessage('Mot existant')
   else
   begin
     i := fAnnonceMotNouveau(motNouv);
     if i>=0 then iMot :=  i;
     Edit4.Clear;
   end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var indexMotCour  : integer;
    motCour, Rep : string;
begin
//le mot peut être supprimé si aucun lien ne lui est affecté
     motCour := UTF8ToAnsi(Edit4.Caption);
     indexMotCour := listeMots.IndexOf(motCour);
     if (indexMotCour<0) then ShowMessage ('Supprimé')
     else if (chercheTab(indexMotCour)<0) then
     begin
       Rep := 'Supprimer le mot '+ Edit4.Caption +' ? ';
       if MessageDlg ('Suppression', Rep, mtConfirmation,
                        [mbYes, mbNo],0) = mrYes
       then SupMot(motCour, indexMotCour);
       MAJBalayage;
       Edit4.Clear;
     end
     else ShowMessage ('Supprimez les liens avant de supprimer le mot');
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  ShowMessage('Supprimez le mot, puis ajoutez le nouveau mot');
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;
  listeMots.CaseSensitive:=True;
  LireFichier(listeMots);
  nMots := listeMots.Count;
  lireLiens;
  iMot := 0;
  Edit3.Clear;
  Edit2.Clear;
  Label1.Caption := 'saisir les lettres séparées par le signe $';
  MAJBalayage;
  cAcc := UTF8ToAnsi('àâäéèêëïîôùûü&#255;ç-'' ');
//regroupe tous les caractères à remplacer
  sAcc := 'aaaeeeeiiouuuyc';
//regroupe tous les caractères de substitution
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 := listeMots.IndexOf(ListBox3.Items[ListBox3.ItemIndex]);
  Label1.Caption:= listeMots[iMot];
 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]);
   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 := 'Lex10 '+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
  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;

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;
//les variables sAcc et cAcc sont créées au démarrage
begin
 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 : integer;
    referMot : 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 := Label4.Caption;
  ListBox4.Items := ListBox1.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.tabLogiqueExit(Sender: TObject);
begin
 SetLength(tabReq, 0);
 SetLength(tabOccur, 0);
end;

procedure TForm1.tabLogiqueShow(Sender: TObject);
begin
  edReq.Clear;
  lisReq.Clear;
  labReq.Caption:= 'Requête ';
  labMasq.Caption := 'saisir les lettres séparées'+#13+' par le signe $';
  boutMasq.Enabled:=False;
  edMasq.Clear;
  edMasq.Visible:=False;
  labMasq.Visible:=False;
  lisMasq.Visible:=False;
  SetLength(tabReq, 0);
  SetLength(tabOccur, 0);
end;

procedure TForm1.TabSheet1Show(Sender: TObject);
begin
  MAJBalayage;
end;

procedure TForm1.TabSheet3Show(Sender: TObject);
begin
  MAJBalayage;
end;

procedure TForm1.TabSheet4Show(Sender: TObject);
begin
  MAJSupp;
end;

procedure TForm1.TabSheet5Show(Sender: TObject);
begin
   Edit4.Caption := AnsiToUTF8(listeMots[iMot]);
end;


end.

précédentsommairesuivant
Ce nom peut varier selon les manipulations antérieures.
Nous avons vu précédemment comment insérer un caractère spécial dans un bouton.
Les résultats peuvent varier fortement selon les mots-clés choisis.
Un tri par ordre alphabétique facilitera sa lecture.
La méthode de création de procédure a fait l'objet de nombreuses descriptions dans les chapitres précédents.
Les variables sont automatiquement réinitialisées, ce qui permet de répéter les recherches.
Rappelons quand même que le logiciel dispose déjà d'une palette de plus de 337 000 réponses possibles !
La plupart des liens sont tirés de définitions rencontrées dans des mots croisés, notamment de problèmes présentés par Laclos.

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.