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.
Ensuite, nous insérons cinq composants que nous renommons et définissons ainsi :
- 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 :
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 :
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 :
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 :
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 :
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 :
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).
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.
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 :
À 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 :
- Le Label7, renommé labMasq, rappelle qu'il faut saisir les lettres connues séparées par le signe « $ » ;
- un Edit, renommé edMasq, qui recevra les indications de l'utilisateur, couleur $00F4ECFF ;
- 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 ;
- un listBox, renommé lisMasq, couleur $00F4ECFF.
Le code peut s'écrire ainsi :
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 :
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 :
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 :
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.
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 :
L'autre mot-clé est « lavabo ». L'affichage donne ceci :
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) :
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 :
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 ⇪ 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('à âäéèêëïîôùûüÿç-'' ');
//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.