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

L'art des « Soundex »

Non les soundex ne sont pas de petites bêtes rampantes que l'on tue à l'aide d'un insecticide… Ce sont en fait des mécanismes de recherche portant sur la consonance des mots. Ils sont en général utilisé dans de très grandes bases de données pour lesquelles la recherche approchée d'un nom peut être d'une très grande utilité...
Nous avons réalisé ces petites bêtes, à l'aide de DELPHI 3. Mais n'importe quel autre langage performant (C++, Java) peut être utilisé à ces fins. ♪

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

Préambule

Le terme Soundex remonte à 1918. Le premier algorithme de ce type a été inventé par Margaret O'Dell et Robert C. Russell, probablement à cause des problèmes liés au recensement américain. En effet, de part leur constitution, les États Unis d'Amérique sont tenus à recenser leur population tous les 10 ans. A la fin du siècle dernier, le problème du recensement était devenu un casse tête majeur. Traiter des informations concernant une population de plusieurs dizaines de millions d'américains à la main demandait un travail phénoménal. Le premier a en tirer parti fût un certain Hollerith, qui fabriqua et introduisit les premières machines mécanographiques comptables, réduisant ainsi les temps de traitement des informations de 75%. Dans ce même temps de nombreuses personnes trouvèrent des idées astucieuses pour trier, classer, rechercher parmi les données collectées. Il en fût sans doute ainsi du premier mécanisme de recherche par consonance, que ses auteurs appelèrent Soundex. Depuis, ce terme regroupe une famille d'algorithmes que nous allons détailler.

1. Le principe

Comment dans une liste de nom de personne arriver à retrouver un certain DUPONT ou DUPOND ou DUPAN ou encore DEPAIN ???
C'est simple, il suffit de se baser sur la consonance et non sur les mots eux-mêmes.

Tous les algorithmes de Soundex reposent sur un principe de base qui consiste à codifier le mot en éliminant les lettres en doubles, les lettres muettes (H en particulier) et en rapprochant les sons de certaines lettres. Une fois cette codification obtenue on la stocke auprès de la donnée de base et on effectue la recherche par comparaison directe entre le Soundex ainsi obtenu et le mot recherché codifié lui aussi en Soundex.

La recherche en est donc très performante puisqu'elle aboutit à une requête dont le critère est l'égalité, et pour peu que l'on place un index sur le champ qui stocke le code du soundex, alors elle s'avère aussi rapide que de trouver un enregistrement pas sa clef.

Certaines base de données utilisent nativement des Soundex pour la recherche. Il en est ainsi de Paradox et de son opérateur « Comme » valable dans les requêtes QBE, de Oracle, ou encore de Watcom SQL devenu SQL Anywhere.
Mais attention : dans tous ces cas, il est probable que votre « soundex » fonctionne sur la consonance anglo-saxonne du langage et non sur les sons spécifiques à la langue française.

2. Le premier Soundex

Voici l'algorithme original de Russel & O'Dell datant de 1918

  • On retranscrit le mot en majuscules
  • On conserve la première lettre du mot
  • On élimine ensuite toutes les voyelles, le H et le W
  • On transcode ensuite les lettres restantes à l'aide de la table suivante
Lettre Type de consonnance code
B F P V Bilabiales 1
C G J K Q S X Z Labiodentales 2
D T Dentales 3
L Alvéolaires 4
M N Vélaires 5
R Laryngales 6
  • On élimine ensuite toutes les paires consécutives de chiffres dupliquées
  • On ne conserve que 4 caractères du Soundex ainsi obtenu, et on le complète par des zéros le cas échéant

Compte tenu que les tables de caractères modernes, permettent maintenant de saisir des lettres majuscules accentuées, il est nécessaire de transcrire ces lettres en lettres simples. En particulier, dans la langue française, le c majuscule avec cédille (Ç ) sera transformé en S. De même que le caractère Œ (dans le mot cœur par exemple) sera transformé en E.

De plus il est nécessaire de supprimer les espaces morts avant et après le mot ainsi que les blancs et le tiret.

Toute cette préparation s'effectue dans une fonction commune à tous les soundex, de nom « prepare ».

3. Le code

Voici le code DELPHI (Pascal Objetc) associé à ce premier Soundex

 
Sélectionnez
implementation

uses
   sysUtils;

// On vide les blancs en tête et queue, on converti la chaîne en majuscule
// et on remplace les majuscules accentuées, le c avec cédille majuscule
// et l'e dans l'o majuscule Œ en lettre équivalent en majuscules normales
Function prepare(sIn : string) : string;
var
   tailleSin, i : integer;
   car          : char;
   sOut         : string;
begin
// mise en majuscule
sIn := Trim(sIn);
sIn := upperCase(sIn);
tailleSin := length(sIn);
sOut := '';
for i:= 1 to tailleSin
do
begin
     car := sIn[i];
     CASE car of
        'Â','Ä','À' :         car := 'A';
        'Ç' :                 car := 'S';
        'È','É','Ê','Ë','Œ' : car := 'E';
        'Î','Ï' :             car := 'I';
        'Ô','Ö' :             car := 'O';
        'Ù','Û','Ü' :         car := 'U';
     END;
     sOut := sOut+car;
end;
// suppression des blancs et des tirets
sIn := sOut;
sOut := '';
for i := 1 to length(sIn)
do
  if (sIn[i] <> ' ') and (sIn[i] <> '-')
  then
      sOut := sOut + sIn[i];
result := sOut;
end;

// corps de la fonction soundex
function soundex(sIn : string) : sound;
type
    TabloLettres = array[1..26] of char;
Const
    Encode : TabloLettres =
           ('0','1','2','3','0','1','2','0','0','2',
            '2','4','5','5','0','1','2','6','2','3',
            '0','1','0','2','0','2');
var
   iSX, iiSX  : smallint;
   tailleSin  : integer;
   sOut       : string;
begin

// cas trivial : la chaîne est vide
if sIn = ''
then
begin
   result := '0000';
   exit;
end;

// on prepare la chaine
sIn := prepare(sIn);

// traitement du second effet de bord : chaîne de longueur 1
if length(sIn) = 1
then
begin
   result := copy(sOut,1,1)+'000';
   exit;
end;

// 3e effet de bord : la première lettre est un H on la retire du mot
if sIn[1] = 'H'
then
   sIn := copy(sIn,2,tailleSin-1);

// traitement pour tous les autres cas
// boucle sur la longueur de la chaîne cible
tailleSIn := length(sIn);
for iSX :=2 to tailleSIn
do
// si le caractère est compris entre les lettres A à Z : on transcode
   if sIn[iSX] in ['A'..'Z']
   then
      sIn[iSX] := enCode[ord(sIn[iSX])-ord('A')+1]
// sinon le caractère n'est pas compris entre A et Z : on pose un zero
   else
      sIn[iSX] := '0';

// on récupère la première lettre du mot
sOut:='';
sOut := sIn[1];
// seconde phase de transcodage
iiSX := 2;
for iSX :=2 to tailleSIn
do
begin
// si le caractère est un différent de zéro on retient
   if sIn[iSX] <> '0'
   then
   begin
      sout := sout+sIn[iSX];
//      sout[iiSX] := sIn[iSX];
      iiSX := iiSX+1;
   end;
// si l'on dépasse les 4 caractères, on quitte la boucle
   if iiSX > 4
   then
   begin
      result := sOut;
      exit;
   end;
end;
// moins de 4 caractères : on complète par des zéros
While length(sOut) < 4
do
   sout := sout+'0';
result := sOut;
end;

4. Soundex 2

Soundex 2 est un algorithme francisé par votre rédacteur, et dérivé de l'algorithme décrit dans le livre de Joe Celko - « SQL avancé », parue en 1995 chez Thomson International Publishing. Il repose sur l'algorithme de Gus Baird (Georgia Tech) énoncé en page 85.

Contrairement au précédent qui ne fait appel qu'à des chiffres à l'exception du premier caractère, cette nouvelle version conserve la plupart des lettres. En comparant les deux versions, on trouve, pour la première un nombre de combinaisons possibles de 26x10x10x10 = 26 000 alors que dans cette version améliorée le nombre de combinaisons différentes monte jusqu'aux environs de 20x20x20x20 = 160 000
Il se révèle donc plus performant dans de nombreux cas, c'est à dire qu'il permet de sélectionner moins d'occurrence lors des recherches avec le même encombrement de 4 caractères.

Voici cette nouvelle version francisée :

  • Éliminer les blancs à droite et à gauche du nom
  • Convertir le nom en majuscule
  • Convertir les lettres accentuées et le c cédille en lettres non accentuées
  • Eliminer les blancs et les tirets
  • Remplacer les groupes de lettres suivantes par leur correspondance (en conservant l'ordre du tableau) :
GUI KI
GUE KE
GA KA
GO KO
GU K
CA KA
CO KO
CU KU
Q K
CC K
CK K
  • Remplacer toutes les voyelles sauf le Y par A exceptée s'il y a un A en tête
  • Remplacer les préfixes suivants par leur correspondance :
MAC MCC  
ASA AZA (ASAmian)
KN NN (KNight)
PF FF (PFeiffer)
SCH SSS (SCHindler)
PH FF (PHilippe)
  • Supprimer les H sauf s'ils sont précédés par C ou S
  • Supprimer les Y sauf s'il est précédé d'un A
  • Supprimer les terminaisons suivantes A, T, D et S
  • Enlever tous les A sauf le A de tête s'il y en a un
  • Enlever toutes les sous chaînes de lettre répétitives
  • Conserver les 4 premiers caractères du mot et si besoin le compléter avec des blancs pour obtenir 4 caractères

Le code de cette version du soundex utilise une procédure de recherche et remplacement intitulée « SearchReplace », dont voici le code :

 
Sélectionnez
// fonction de recherche et remplacement de sous chaîne dans une chaîne
Function SearchReplace(sIn : string; mot1 : string; mot2 : string) : string;
var
   tailleSin : integer;
   TailleMot : integer;
   posMot : integer;
begin
//effet de bord : le mot à remplacer est le même que le mot à chercher
if mot1 = mot2
then
begin
    result := sIn;
    exit;
end;
// ATTENTION : effet de bord non géré :
// le mot à remplacer contient le mot à chercher
// exemple : remplacer 'no' par 'not'
tailleSin := length(Sin);
TailleMot := length(mot1);
posMot := pos(mot1,sIn);
While posMot > 0
do
begin
// le mot à remplacer est en début de chaîne
     if posMot = 1
     then
         sIn := mot2+copy(Sin,tailleMot+1,tailleSin-tailleMot)
     else
// le mot à remplacer est en fin de chaîne
        if posMot +  tailleMot -1 = tailleSin
        then
           sIn := copy(Sin,1,posMot-1)+mot2
// le mot à remplacer est au milieu
        else
            sIn := copy(Sin,1,posMot-1)+mot2
                +copy(sin,posMot+tailleMot,tailleSin-(posMot+tailleMot-1));
     posMot := pos(mot1,sIn);
end;
result := Sin;
end;

Enfin, voici le code de ce second Soundex, intitulé Soundex2 :

 
Sélectionnez
// soundex2 francisé par Frédéric BROUARD
function soundex2(sIn : string) : sound;
type
    TabloVoyell = array[1..4] of char;
    TabloCombi1 = array[1..11,1..2] of string;
    TabloCombi2 = array[1..5,1..2] of string;
Const
    Voyelle : TabloVoyell =
           ('E',
            'I',
            'O',
            'U');
    Combin1 : TabloCombi1 =
           (('GUI','KI'),
            ('GUE','KE'),
            ('GA','KA'),
            ('GO','KO'),
            ('GU','K'),
            ('CA','KA'),
            ('CO','KO'),
            ('CU','KU'),
            ('Q','K'),
            ('CC','K'),
            ('CK','K'));
    Combin2 : TabloCombi2 =
           (('ASA','AZA'),
            ('KN','NN'),
            ('PF','FF'),
            ('PH','FF'),
            ('SCH','SSS'));
var
   i        : integer;     // indice de boucle
   lSin     : integer;     // longueur de la chaîne d'entrée
   prfx     : string;      // préfixe
   sIn2     : string;      // sIn moins la première lettre
   let      : string;      // lettre
begin

// cas trivial : la chaîne est vide
if sIn = ''
then
begin
   result := '    ';
   exit;
end;

// on prepare la chaine : étapes 1, 2 et 3
sIn := prepare(sIn);
lSin := length(sIn);

// traitement du second effet de bord : chaîne de longeur 1
if lSin = 1
then
begin
   result := sIn+'   ';
   exit;
end;

// étapes 1, 2, 3 et 4: élimine les blancs, met en majuscule,
// convertit les accents et le c cédille
sIn := prepare(sIn);

// étape 5 : on remplace les consonnances primaires
for i := 1 to 4
do
  sIn := SearchReplace(sIn,Combin1[i,1],Combin1[i,2]);

// étape 6 : on remplace les voyelles sauf le Y et sauf la première par A
lSin := length(sIn);
sIn2 := copy(sIn,2,lSin-1);
for i := 1 to 4
do
  sIn2 := SearchReplace(sIn2,Voyelle[i],'A');
sIn := sIn[1]+sIn2;

// étape 7 : on remplace les préfixes
lSin := length(sIn);
if lSin>=2
then
begin
    prfx := copy(sIn,1,2);
    if (prfx = 'KN')
    then
        prfx := 'NN';
    if (prfx = 'PH') or (prfx = 'PF')
    then
        prfx := 'FF';
    if lSin = 2
    then
        sIn := prfx
    else
        sIn := prfx+copy(sIn,3,lSin-2);
end;
if lSin>=3
then
begin
    prfx := copy(sIn,1,3);
    if (prfx = 'MAC')
    then
        prfx := 'MCC';
    if (prfx = 'SCH')
    then
        prfx := 'SSS';
    if (prfx = 'ASA')
    then
        prfx := 'AZA';
    if lSin = 3
    then
        sIn := prfx
    else
        sIn := prfx+copy(sIn,4,lSin-3);
end;

// étape 8 : on conserve la première lettre et on fait
// les remplacements complémentaires
sIn2 := copy(Sin,2,lSin-1);
for i := 1 to 5
do
  sIn2 := SearchReplace(sIn2,Combin2[i,1],Combin2[i,2]);
sIn := sIn[1]+sIn2;

// étape 9 : suppression des H sauf CH ou SH
lSin := length(sIn);
sIn2 := '';
for i := 1 to lSin
do
// pas de H on conserve la lettre
  if (sIn[i] <> 'H')
  then
  begin
      sIn2 := SIn2+sIn[i];
      continue;
  end
  else
// le H est précédé d'un S ou d'un C on le conserve
      if (i>1) and ((sIn[i-1] = 'C') or (sIn[i-1] = 'S'))
      then
          sIn2 := Sin2+sIn[i];
sIn := Sin2;
lSin := length(sIn);

// étape 10 : suppression des Y sauf précédés d'un A
lSin := length(sIn);
sIn2 := '';
for i := 1 to lSin
do
// pas de Y on conserve la lettre
  if (sIn[i] <> 'Y')
  then
  begin
      sIn2 := SIn2+sIn[i];
      continue;
  end
  else
// le Y est précédé d'un A on le conserve
      if (sIn[i-1] = 'A')
      then
          sIn2 := Sin2+sIn[i];
sIn := Sin2;
lSin := length(sIn);

// étape 11 : on supprime les terminaisons A, T, D, S
let := copy(sIn,lSin,1);
if (let = 'A') or (let = 'D') or(let = 'S') or (let = 'T')
then
    sIn := copy(sIn,1,lSin-1);

// étape 12 : suppression de tous les A sauf en tête
lSin := length(sIn);
sIn2 := copy(sIn,1,1);
for i := 2 to lSin
do
// pas de A on conserve la lettre
  if (sIn[i] <> 'A')
  then
  begin
      sIn2 := sIn2+sIn[i];
      continue;
  end;
sIn := Sin2;
lSin := length(sIn);

// étape 13 : on supprime les lettres répétitives
let := copy(sIn,1,1);
sIn2 := let;
for i := 2 to lSin
do
begin
  if sIn[i] = let
  then
      continue;
  let := sIn[i];
  Sin2 := Sin2 + sIn[i];
end;
sIn := sIn2;

// étape 14 : on ne retient que 4 caractères ou on complète avec des blancs
while length(sIn) < 4
do
   Sin := Sin+' ';
if length(sIn) > 4
then
   sIn := copy(sIn,1,4);

result := sIn;

end;

5. Phonex

Phonex est un algorithme de Soundex plus perfectionné encore que la version francisée de Soundex2 et développé par votre serviteur. Sachez que Phonex est optimisée pour le langage français, sait reconnaître différents types de sons comme les sons ‘on', ‘ai', ‘ein', etc... et place son résultat sous la forme d'un réel de type double précision (5.0 x 10-324 .. 1.7 x 10308 sur 15 à 16 chiffres significatifs). Son temps de calcul est double de Soundex et 30% supérieure seulement à Soundex2.

Algorithme Phonex
Copyright Frédéric BROUARD (31/3/99)

Merci à Florence MARQUIS, orthophoniste, pour son aide à la mise au point de cet algorithme

1 remplacer les y par des i
2 supprimer les h qui ne sont pas précédés de c ou de s ou de p
3 remplacement du ph par f
4 remplacer les groupes de lettres suivantes :

gan kan
gam kam
gain kain
gaim kaim

5 remplacer les occurrences suivantes, si elles sont suivies par une lettre a, e, i, o, ou u :

ain yn
ein yn
aim yn
eim yn

6 remplacement de groupes de 3 lettres (sons 'o', 'oua', 'ein') :

eau o
oua 2
ein 4
ain 4
eim 4
aim 4

7 remplacement du son ‘é' :

é y
è y
ê y
ai y
ei y
er yr
ess yss
et yt

8 remplacer les groupes de 2 lettres suivantes (son ‘an' et ‘in'), sauf s'il sont suivi par une lettre a, e, i o, u ou un son 1 à 4 :

an 1
am 1
en 1
em 1
in 4

9 remplacer les s par des z s'ils sont suivi et précédés des lettres a, e, i, o,u ou d'un son 1 à 4
10 10 remplacer les groupes de 2 lettres suivants :

oe e
eu e
au o
oi 2
oy 2
ou 3

11 remplacer les groupes de lettres suivants

ch 5
sch 5
sh 5
ss s
sc s

12 remplacer le c par un s s'il est suivi d'un e ou d'un i
13 remplacer les lettres ou groupe de lettres suivants :

c k
q k
qu k
gu k
ga ka
go ko
gy ky

14 remplacer les lettres suivante :

a o
d t
p t
j g
b f
v f
m n

15 Supprimer les lettres dupliquées
16 Supprimer les terminaisons suivantes : t, x
17 Affecter à chaque lettres le code numérique correspondant en partant de la dernière lettre

0 1
1 2
2 3
3 4
4 5
5 e
6 f
7 g
8 h
9 i
10 k
11 l
12 n
13 o
14 r
15 s
16 t
17 u
18 w
19 x
20 y
21 z

18 Convertissez les codes numériques ainsi obtenu en un nombre de base 22 exprimé en virgule flottante.

Exemple : nom « PHYLAURHEIMSMET »

1 PHILAURHEIMSMET
2 PHILAUREIMSMET
3 FILAUREIMSMET
4 FILAUREIMSMET
5 FILAUREIMSMET
6 FILAUR4SMET
7 FILAUR4SMY
8 FILAUR4SMY
9 FILAUR4SMY
10 FILOR4SMY
11 FILOR4SMY
12 FILOR4SMY
13 FILOR4SMY
14 FILOR4SNY
15 FILOR4SNY
16 FILOR4SNY
17 FILOR4SNY
18 6, 9, 11, 13, 14, 5, 15, 12, 20
19 6*22^(-1) + 9*22^(-2) + 11*22(-3) + 13*22(-4) + 14*22(-5) + 5*22(-6) + 5*22(-7) + 12*22(-8) + 20*22(-9)
20 0,179864540784299185

6. Tests

Pour réaliser nos tests, nous avons utilisé une base de données comportant 32 137 noms de personnes.
Les temps de calcul avec un Pentium 300 Mhz équipé de 64 Mo de RAM, ont été les suivants :

 
Sélectionnez
   Soundex      7 secondes
   Soundex2    11 secondes
   Phonex      14 secondes

Pour la table complète.

Image non disponible

Parmi les noms plus fréquemment rencontrés, nous avons retenu pour les tests, les noms suivants :

Nom Soundex Soundex2 Phonex Soundex Soundex2 Phonex Comme *
MARTIN M635 MRTN 9 215 667 719 874,02 33 31 2 110
BERNARD B656 BRNR 3 920 163 630 012,01 19 18 2 92
FAURE F600 FR 5 242 968 742 851,01 13 51 8 80
PEREZ P620 PRZ 1,2657878733906e+13 24 12 7 40
GROS G620 GR 6 073 270 560 252,01 25 26 6 33
CHAPUIS C120 CHP 2 070 855 664 353,00 15 8 3 11
BOYER B600 BYR 3 250 278 687 537,01 26 3 1 97
GAUTHIER G360 KTR 7 630 177 314 816,02 10 12 10 30
REY R000 RY 1,1044274933412e+13 15 11 5 31
BARTHELEMY B634 BRTL 3 655 717 558 143,01 35 23 2 4
HENRY E560 ANR 506 105 880 021,001 6 7 2 21
MOULIN M450 MLN 9 209 223 008 496,02 12 28 5 50
ROUSSEAU R220 RS 1,0805759350911e+13 36 17 7 11

On peut alors faire la moyenne des nombres d'occurences et on obtient le tableau suivant :

  Soundex Soundex2 Phonex Comme *
MOYENNES 21 19 5 47

* "comme" est l'opérateur "comme" (like) du QBE de Paradox qui effectue des comparaisons phonétiques.

Dans 8 cas sur 13, Soundex2 récupère moins d'occurrences que Soundex. Mais dans le cas de FAURE, la différence est très importante. Soundex récupère FEREY, FERY, FREY et FUERI, tandis qu'il oublie FORT ! en revanche Soundex2 se montre plus tolérant et récupère FORT et PHAURE.

Quant à Phonex, il récupère très peu de noms :

  • Pour FAURE, il a récupéré : FARRE, FAURE, FORT, FOURR, PHAURE, VARD et VAURE
  • Pour PEREZ, il a récupéré : PERET, PEREZ, PERRAIX, PERRET, PEYRET, DEREI, DHERET
  • Pour GROS, il a récupéré : GRAU, GROS, GROSS, GROZ, GRAS, GRASS
  • Pour GAUTHIER, il a récupéré : GAUTHIER, GAUTIER, GOUDIER, GOUTHIER, CADIER, CATTIER, COPIER, COTTIER, COUPIER, COUTIER, tandis que Soundex n'a pas récupéré GOUTHIER...
  • Pour MOULIN, il récupère : MALLEIN,MOLEINS, MOLIN, MOULIN, NAULIN
  • Pour ROUSSEAU, il récupère ROUSSEAU, ROUSSEAUX, ROUSSOT, RASSAT, RASSSAT, ROSSAT, ROSSO
  • Et pour REY : RAIS, RAY, REIX, REY et REYT

Bref, nous vous conseillons d'utiliser Soundex 2, que votre rédacteur (et auteur) vous offre gratuitement, lorsque la base de données est limitée à quelques dizaines de milliers de noms.

7. Implémentation dans les bases de données

Aujourd'hui, la plupart des implémentation de SQL des serveurs sont dotés d'un algorithme de Soundex de base, reprenant celui de Russel et O'Dell. Ainsi dans SQL Server de Microsoft, la fonction SOUNDEX() renvoi le code de base du Soundex.

Pour rechercher les personnes dont la patronyme a la même consonance qu'un nom tapé au clavier on peut, par exemple, utiliser le code SQL suivant :

 
Sélectionnez
Select * from T_PERSONNE 
Where SOUNDEX(:LeNom) = SOUNDEX(T_PERSONNE.NOM_PERS)

Où :LeNom est la variable passée en argument de la requête.

Cependant cette manière de faire est assez pénalisante pour le traitement, surtout, et c'est l'intérêt du Soundex, lorsque la base est volumineuse, les tables conséquentes et le nombre de ligne de la table PERSONNE importante.
Dans ce cas une meilleure manière d'implémenter un tel dispositif consiste à créer dans la table personne, une colonne SOUNDEX_PERS CHAR(4) dans laquelle on va alimenter automatiquement les données à l'aide des triggers INSERT et UPDATE.
A l'occasion vous avez tout intérêt à poser un index sur cette colonne afin d'accélérer le processus de recherche et d'extraction.
Dès lors, on pourra effectuer une recherche sur cette colonne directement plutôt que d'appeler 13 246 fois la procédure Soundex pour rechercher dans une table comportant 13 245 noms.

Exemple :

 
Sélectionnez
Select * from T_PERSONNE 
Where SOUNDEX(:LeNom) = T_PERSONNE.SOUNDEX_NOM_PERS

Bien entendu si vous choisissez d'utiliser un Soundex personnalisé comme Soundex2 ou Phonex il faudra dimensionner la colonne en fonction du type de données à recevoir.

A lire sur le sujet :

Soundex :

Metaphone, double metaphone :

8. En complément

Afin de savoir si deux SOUNDEX sont très différents ou très peu différents, on a développé toute une série de fonctions dont l'utilisation est à prendre "avec des pincettes".

8-1. HAMMING et sa différence

Différence de HAMMING est le nombre de caractères non identiques à la même position dans deux châines de caractères de même longueurs.
Par exemple les chaînes suivantes : "D823" et "M843" ont une différence de HAMMING de 2.
Ainsi deux soundex sont identiques si la différence de HAMMING vaut zéro. Il sont semblable si cette différence est 1. Ils sont totalement dissemblables si la distances de HAMMING est 4 (le maximum dans ce cas).
La différence de HAMMING est un algorithme simple et très performant car d'un coût linéaire.
On trouve cette fonction opérant notamment sur les soundex sur quelques SGBDR dont SQL Server (fonction DIFFERENCE qui, curieusement fonctionne "à l'envers")...

A lire sur le sujet : http://merlin.mbcr.bcm.tmc.edu:8001/bcd/Curric/PrwAli/node2.html

8-2. Levenshtein et sa distance

LDA (Levenshtein Distance Algorithme) calcule la distance de Levenshtein (nom de son inventeur) définie comme le nombre minimal de caractères qu'il faut remplacer, insérer ou modifier pour transformer une chaîne en une autre.

Quelques exemples :

 
Sélectionnez
PORTES
PORTER
1 (transformation du S en R)
 
Sélectionnez
PORTE
PORTER
1 (ajout d'une lettre R)
 
Sélectionnez
POTES
PORTES
1 (ajout d'une lettre R)
 
Sélectionnez
POTE
POSTER
 
Sélectionnez
2 : POTE    étape 0
    POSTE   étape 1
    POSTER  étape 2
 
Sélectionnez
DEPORTEES
POSTERS
 
Sélectionnez
4 : POSTERS
    D POSTERS  étape 1
    DEPOSTERS  étape 2
    DEPORTERS  étape 3
    DEPORTEES  étape 4

A noter, la littérature anglaise parle de "edit distance". Faut-il y voir un anti soviétisme primaire ???

En fait, cette "distance" est le nombre des opérations unitaires d'insertions, de remplacements et d'effacements conduisant la chaîne source a devenir la chaîne cible. Cette opération et l'algorithme qui en découle est considéré comme étant à l'origine des premières méthodes de programmation d'algorithmes génétiquement modifiables. En effet cet algorithme utilise la technique du "backtraking" et par conséquent la récursivité.

A lire sur le sujet :
La communication originale : V. I. Levenshtein, "Binary Codes Capable of Correcting Deletions, Insertions and Reversals," in Soviet Physics Dokl. n°10, p707 à 710 (1966)
http://www.merriampark.com/ld.htm
http://www-igm.univ-mlv.fr/~lecroq/seqcomp/node2.html
http://www.cut-the-knot.com/do_you_know/Strings.html

Ces algorithmes sont actuellement forts utilisés dans le cas de la recherche génétique car ils permettent de comparer les codes génétiques qui sont représentés en machine par de très grandes châines de caractères ne comprenant que les lettres a c g et t.
A lire sur le sujet : http://www.csis.hku.hk/~nikos/courses/CSIS7101/strings.pdf

Implémentation des fonctions SOUNDEX, SOUNDEX2 et PHONEX en Delphi

 
Sélectionnez
unit Sndx;
//--------------------------------------------------------------------------
// Copyright :
// Frédéric BROUARD pour Phonex - DROITS D'AUTEUR Réservé
// Pour l'utiliser, contacter Frédéric BROUARD à l'e-mail :
// brouardf@club-internet.fr
//
//--------------------------------------------------------------------------

interface
// type de variable en retour de la fonction soundex
Type Sound = string[4];
// déclaration des routines utilisées par les soundex
Function prepare(sIn : string) : string;
Function SearchReplace(sIn : string; mot1 : string; mot2 : string) : string;
Function pow(x,y : integer) : double;
// déclaration des fonctions de soundex
Function soundex(sIn : string) : sound;
Function soundex2(sIn : string) : sound;
Function phonex(sIn : string) : double;

implementation

uses
   sysUtils
   ,dialogs
   ;

//--------------------------------------------------------------------------
// fonction de recherche et remplacement de sous chaîne dans une chaîne
//--------------------------------------------------------------------------
Function SearchReplace(sIn : string; mot1 : string; mot2 : string) : string;
var
   tailleSin : integer;
   TailleMot : integer;
   posMot : integer;
begin
//effet de bord : le mot à remplacer est le même que le mot à chercher
if mot1 = mot2
then
begin
    result := sIn;
    exit;
end;
// effet de bord non géré : le mot à remplacer contient le mot à chercher
// exemple : remplacer 'no' par 'not'
tailleSin := length(Sin);
TailleMot := length(mot1);
posMot := pos(mot1,sIn);
While posMot > 0
do
begin
// le mot à remplacer est en début de chaîne
     if posMot = 1
     then
         sIn := mot2+copy(Sin,tailleMot+1,tailleSin-tailleMot)
     else
// le mot à remplacer est en fin de chaîne
        if posMot +  tailleMot -1 = tailleSin
        then
           sIn := copy(Sin,1,posMot-1)+mot2
// le mot à remplacer est au milieu
        else
            sIn := copy(Sin,1,posMot-1)+mot2
                +copy(sin,posMot+tailleMot,tailleSin-(posMot+tailleMot-1));
     posMot := pos(mot1,sIn);
end;
result := Sin;
end;
 

//--------------------------------------------------------------------------
// fonction de recherche et remplacement de sous chaîne dans une chaîne
// sauf si la lettre suivante est une voyelle ou un son de 1 à 4
//--------------------------------------------------------------------------
Function SRSaufVoyelle (sIn : string; mot1 : string; mot2 : string) : string;
const
     Voyelle = ['a','e','i','o','u','y','1','2','3','4'];
var
   tailleSin : integer;
   TailleMot : integer;
   posMot : integer;
   derLet : char;
begin
//effet de bord : le mot à remplacer est le même que le mot à chercher
if mot1 = mot2
then
begin
    result := sIn;
    exit;
end;
// effet de bord non géré : le mot à remplacer contient le mot à chercher
// exemple : remplacer 'no' par 'not'

tailleSin := length(Sin);
TailleMot := length(mot1);
posMot := pos(mot1,sIn);

While posMot > 0
do
begin
// la lettre suivante est-elle une voyelle ?
     if posMot+tailleMot-1 < tailleSin
     then
     begin
         derlet := sIn[posMot+tailleMot];
         if derLet in voyelle
         then
             result := sIn;
             exit;
     end;
// le mot à remplacer est en début de chaîne
     if posMot = 1
     then
         sIn := mot2+copy(Sin,tailleMot+1,tailleSin-tailleMot)
     else
// le mot à remplacer est en fin de chaîne
        if posMot +  tailleMot -1 = tailleSin
        then
           sIn := copy(Sin,1,posMot-1)+mot2
// le mot à remplacer est au milieu
        else
            sIn := copy(Sin,1,posMot-1)+mot2
                +copy(sin,posMot+tailleMot,tailleSin-(posMot+tailleMot-1));
     posMot := pos(mot1,sIn);
end;
result := Sin;
end;

//--------------------------------------------------------------------------
// fonction de recherche et remplacement de sous chaîne dans une chaîne
// sauf si la lettre suivante est une voyelle ou un son de 1 à 4
//--------------------------------------------------------------------------
Function SRSauf2Voyelle (sIn : string; mot1 : string; mot2 : string) : string;
const
     Voyelle = ['a','e','i','o','u','y','1','2','3','4'];
var
   tailleSin : integer;
   TailleMot : integer;
   posMot : integer;
   derLet : char;
   premlet : char;
begin
//effet de bord : le mot à remplacer est le même que le mot à chercher
if mot1 = mot2
then
begin
    result := sIn;
    exit;
end;
// effet de bord non géré : le mot à remplacer contient le mot à chercher
// exemple : remplacer 'no' par 'not'

tailleSin := length(Sin);
TailleMot := length(mot1);
posMot := pos(mot1,sIn);

While posMot > 0
do
begin
// y a t-il une lettre précédente et une suivante ?
     if (posMot > 1) and (posMot+tailleMot-1 < tailleSin)
     then
     begin
        premLet := sIn[posMot-1];
        derlet := sIn[posMot+tailleMot];
// ces lettres sont-elles des voyelles ?
        if not ((premLet in voyelle) and (derLet in voyelle))
        then
             exit;
     end;
// le mot à remplacer est en début de chaîne
     if posMot = 1
     then
         sIn := mot2+copy(Sin,tailleMot+1,tailleSin-tailleMot)
     else
// le mot à remplacer est en fin de chaîne
        if posMot +  tailleMot -1 = tailleSin
        then
           sIn := copy(Sin,1,posMot-1)+mot2
// le mot à remplacer est au milieu
        else
            sIn := copy(Sin,1,posMot-1)+mot2
                +copy(sin,posMot+tailleMot,tailleSin-(posMot+tailleMot-1));
     posMot := pos(mot1,sIn);
end;
result := Sin;
end;

//--------------------------------------------------------------------------
// On vide les blancs en tête et queue, on converti la chaîne en majuscule
// et on remplace les majuscules accentuées, le c avec cédille majuscule
//--------------------------------------------------------------------------
// et l'e dans l'o majuscule Œ en lettre équivalent en majuscules normales
Function prepare(sIn : string) : string;
var
   tailleSin, i : integer;
   car          : char;
   sOut         : string;
begin
// mise en majuscule
sIn := Trim(sIn);
sIn := upperCase(sIn);
tailleSin := length(sIn);
sOut := '';
for i:= 1 to tailleSin
do
begin
     car := sIn[i];
     CASE car of
        'Â','Ä','À' :         car := 'A';
        'Ç' :                 car := 'S';
        'È','É','Ê','Ë','Œ' : car := 'E';
        'Î','Ï' :             car := 'I';
        'Ô','Ö' :             car := 'O';
        'Ù','Û','Ü' :         car := 'U';
     END;
     sOut := sOut+car;
end;
// suppression des blancs et des tirets
sIn := sOut;
sOut := '';
for i := 1 to length(sIn)
do
  if (sIn[i] <> ' ') and (sIn[i] <> '-')
  then
      sOut := sOut + sIn[i];
result := sOut;
end;

Function pow(x,y : integer) : double;
var
   xx,yy : double;
begin
   xx := x;
   yy := y;
   result := exp(xx*ln(yy));
end;
 

//--------------------------------------------------------------------------
// corps du premier soundex
//--------------------------------------------------------------------------
function soundex(sIn : string) : sound;
type
    TabloLettres = array[1..26] of char;
Const
    Encode : TabloLettres =
           ('0','1','2','3','0','1','2','0','0','2',
            '2','4','5','5','0','1','2','6','2','3',
            '0','1','0','2','0','2');
var
   iSX, iiSX  : smallint;
   tailleSin  : integer;
   sOut       : string;
begin

// cas trivial : la chaîne est vide
if sIn = ''
then
begin
   result := '0000';
   exit;
end;

// on prepare la chaine
sIn := prepare(sIn);

// traitement du second effet de bord : chaîne de longueur 1
if length(sIn) = 1
then
begin
   result := sIn+'000';
   exit;
end;

// troisième effet de bord : la première lettre est un H on la retire du mot
tailleSin := length(sIn);
if sIn[1] = 'H'
then
   sIn := copy(sIn,2,tailleSin-1);

// traitement pour tous les autres cas
// boucle sur la longueur de la chaîne cible
tailleSIn := length(sIn);
for iSX :=2 to tailleSIn
do
// si le caractère est compris entre les lettres A à Z : on transcode
   if sIn[iSX] in ['A'..'Z']
   then
      sIn[iSX] := enCode[ord(sIn[iSX])-ord('A')+1]
// sinon le caractère n'est pas compris entre A et Z : on pose un zero
   else
      sIn[iSX] := '0';

// on récupère la première lettre du mot
sOut:='';
sOut := sIn[1];
// seconde phase de transcodage
iiSX := 2;
for iSX :=2 to tailleSIn
do
begin
// si le caractère est un différent de zéro on retient
   if sIn[iSX] <> '0'
   then
   begin
      sout := sout+sIn[iSX];
      iiSX := iiSX+1;
   end;
// si l'on dépasse les 4 caractères, on quitte la boucle
   if iiSX > 4
   then
   begin
      result := sOut;
      exit;
   end;
end;
// moins de 4 caractères : on complète par des zéros
While length(sOut) < 4
do
   sout := sout+'0';
result := sOut;
end;
 
 

//--------------------------------------------------------------------------
// soundex2 francisé par Frédéric BROUARD - copyright Frédéric BROUARD
//-------------------------------------------------------------------------

function soundex2(sIn : string) : sound;
type
    TabloVoyell = array[1..4] of char;
    TabloCombi1 = array[1..11,1..2] of string;
    TabloCombi2 = array[1..5,1..2] of string;
Const
    Voyelle : TabloVoyell =
           ('E',
            'I',
            'O',
            'U');
    Combin1 : TabloCombi1 =
           (('GUI','KI'),
            ('GUE','KE'),
            ('GA','KA'),
            ('GO','KO'),
            ('GU','K'),
            ('CA','KA'),
            ('CO','KO'),
            ('CU','KU'),
            ('Q','K'),
            ('CC','K'),
            ('CK','K'));
    Combin2 : TabloCombi2 =
           (('ASA','AZA'),
            ('KN','NN'),
            ('PF','FF'),
            ('PH','FF'),
            ('SCH','SSS'));
var
   i        : integer;     // indice de boucle
   lSin     : integer;     // longueur de la chaîne d'entrée
   prfx     : string;      // préfixe
   sIn2     : string;      // sIn moins la première lettre
   let      : string;      // lettre
begin

// cas trivial : la chaîne est vide
if sIn = ''
then
begin
   result := '    ';
   exit;
end;

// on prepare la chaine : étapes 1, 2 et 3
sIn := prepare(sIn);
lSin := length(sIn);

// traitement du second effet de bord : chaîne de longeur 1
if lSin = 1
then
begin
   result := sIn+'   ';
   exit;
end;

// étapes 1, 2, 3 et 4: élimine les blancs, met en majuscule,
// convertit les accents et le c cédille
sIn := prepare(sIn);

// étape 5 : on remplace les consonnances primaires
for i := 1 to 4
do
  sIn := SearchReplace(sIn,Combin1[i,1],Combin1[i,2]);

// étape 6 : on remplace les voyelles sauf le Y et sauf la première par A
lSin := length(sIn);
sIn2 := copy(sIn,2,lSin-1);
for i := 1 to 4
do
  sIn2 := SearchReplace(sIn2,Voyelle[i],'A');
sIn := sIn[1]+sIn2;

// étape 7 : on remplace les préfixes
lSin := length(sIn);
if lSin>=2
then
begin
    prfx := copy(sIn,1,2);
    if (prfx = 'KN')
    then
        prfx := 'NN';
    if (prfx = 'PH') or (prfx = 'PF')
    then
        prfx := 'FF';
    if lSin = 2
    then
        sIn := prfx
    else
        sIn := prfx+copy(sIn,3,lSin-2);
end;
if lSin>=3
then
begin
    prfx := copy(sIn,1,3);
    if (prfx = 'MAC')
    then
        prfx := 'MCC';
    if (prfx = 'SCH')
    then
        prfx := 'SSS';
    if (prfx = 'ASA')
    then
        prfx := 'AZA';
    if lSin = 3
    then
        sIn := prfx
    else
        sIn := prfx+copy(sIn,4,lSin-3);
end;

// étape 8 : on conserve la première lettre et on fait
// les remplacements complémentaires
sIn2 := copy(Sin,2,lSin-1);
for i := 1 to 5
do
  sIn2 := SearchReplace(sIn2,Combin2[i,1],Combin2[i,2]);
sIn := sIn[1]+sIn2;

// étape 9 : suppression des H sauf CH ou SH
lSin := length(sIn);
sIn2 := '';
for i := 1 to lSin
do
// pas de H on conserve la lettre
  if (sIn[i] <> 'H')
  then
  begin
      sIn2 := SIn2+sIn[i];
      continue;
  end
  else
// le H est précédé d'un S ou d'un C on le conserve
      if (sIn[i-1] = 'C') or (sIn[i-1] = 'S')
      then
          sIn2 := Sin2+sIn[i];
sIn := Sin2;

// étape 10 : suppression des Y sauf précédés d'un A
lSin := length(sIn);
sIn2 := '';
for i := 1 to lSin
do
// pas de Y on conserve la lettre
  if (sIn[i] <> 'Y')
  then
  begin
      sIn2 := SIn2+sIn[i];
      continue;
  end
  else
// le Y est précédé d'un A on le conserve
      if (sIn[i-1] = 'A')
      then
          sIn2 := Sin2+sIn[i];
sIn := Sin2;
lSin := length(sIn);

// étape 11 : on supprime les terminaisons A, T, D, S
let := copy(sIn,lSin,1);
if (let = 'A') or (let = 'D') or(let = 'S') or (let = 'T')
then
    sIn := copy(sIn,1,lSin-1);

// étape 12 : suppression de tous les A sauf en tête
lSin := length(sIn);
sIn2 := copy(sIn,1,1);
for i := 2 to lSin
do
// pas de A on conserve la lettre
  if (sIn[i] <> 'A')
  then
  begin
      sIn2 := sIn2+sIn[i];
      continue;
  end;
sIn := Sin2;
lSin := length(sIn);

// étape 13 : on supprime les lettres répétitives
let := copy(sIn,1,1);
sIn2 := let;
for i := 2 to lSin
do
begin
  if sIn[i] = let
  then
      continue;
  let := sIn[i];
  Sin2 := Sin2 + sIn[i];
end;
sIn := sIn2;

// étape 14 : on ne retient que 4 caractères ou on complète avec des blancs
while length(sIn) < 4
do
   Sin := Sin+' ';
if length(sIn) > 4
then
   sIn := copy(sIn,1,4);

result := sIn;

end;

//-------------------------------------------------------------------------
// FONCTION PHONEX : copyright Frédéric BROUARD
//-------------------------------------------------------------------------
//function phonex(sIn : string) : integer;
function phonex(sIn : string) : double;
Type
   TabSonAI = array[1..4] of string;
   tabCarPhon = array[0..21] of char;
Const
    SonAIA : TabSonAI = ('aina','eina','aima','eima');
    SonAIE : TabSonAI = ('aine','eine','aime','eime');
    SonAII : tabSonAI = ('aini','eini','aimi','eimi');
    SonAIO : tabSonAI = ('aino','eino','aimo','eimo');
    SonAIU : tabSonAI = ('ainu','einu','aimu','eimu');
    CarPhon : TabCarphon = ('1','2','3','4','5','e','f','g','h','i','k','l','n','o','r','s','t','u','w','x','y','z');
var
   i,j,k     : integer;
   car   : char;
   p     : integer;
   let, sin2 : string;
   sOut : array[1..10] of integer;
begin
// cas trivial : la chaîne est vide
if sIn = ''
then
begin
//   result := 0;
result := 0.0;
   exit;
end;

// mise en minuscules
sIn := lowerCase(sIn);

// remplacement des y par des i
sIn := SearchReplace(sIn, 'y', 'i');

// remplacement des lettres accentuées
for i:= 1 to length(sIn)
do
begin
     car := sIn[i];
     CASE car of
        'â','ä','à','Â','Ä','À' : car := 'a';
        'ç','Ç' :                 car := 's';
        'ë','œ','Ë','Œ' :         car := 'e';
        'ï','î','Î','Ï' :         car := 'i';
        'ô','ö','Ô','Ö' :         car := 'o';
        'ù','û','ü','Ù','Û','Ü' : car := 'u';
        'é','ê','È','É','Ê' :     car := 'y';
     END;
     sIn[i] := car;
end;

// on retire les h muets
for i := 1 to length(sIn)
do
begin
  p := pos('h',sIn);
  if p = 1
  then
    sIn := copy(sIn,2, length(sIn)-1)
  else
    if not((sIn[p-1] = 'c') or (sIn[p-1] = 's'))
    then
      if p<length(sIn)
      then
        sIn := copy(sIn,1,p-1)+copy(sIn,p+1,length(sIn)-p)
      else
        sIn := copy(sIn,1,p-1);
end;

// remplacement des ph par des h
sIn := SearchReplace(sIn, 'ph', 'f');

// rempacement de g qui sonnent k devant an, am, ain, aim
sIn := searchReplace(sIn,'gan','kan');
sIn := searchReplace(sIn,'gain','kain');
sIn := searchReplace(sIn,'gam','kam4');
sIn := searchReplace(sIn,'gaim','kaim');

// remplacement du son AI
for i := 1 to 4
do
begin
  sIn := searchReplace(sIn,SonAIA[i],'yna');
  sIn := searchReplace(sIn,SonAIE[i],'yne');
  sIn := searchReplace(sIn,SonAII[i],'yni');
  sIn := searchReplace(sIn,SonAIO[i],'yno');
  sIn := searchReplace(sIn,SonAIU[i],'ynu');
end;

// remplacement des groupes de 3 lettres
sIn := searchReplace(sIn,'eau','o');
sIn := searchReplace(sIn,'oua','2');
sIn := searchReplace(sIn,'ein','4');
sIn := searchReplace(sIn,'ain','4');

// remplacement du son é
sIn := searchReplace(sIn,'ai','y');
sIn := searchReplace(sIn,'ei','y');
sIn := searchReplace(sIn,'er','yr');
sIn := searchReplace(sIn,'ess','yss');
sIn := searchReplace(sIn,'et','yt');
sIn := searchReplace(sIn,'ez','yz');

// remplacement des groupes de 2 lettres sauf si voyelle ou son (1 à 4)
Sin := SRSaufVoyelle(sIn,'an','1');
Sin := SRSaufVoyelle(sIn,'am','1');
Sin := SRSaufVoyelle(sIn,'en','1');
Sin := SRSaufVoyelle(sIn,'em','1');
Sin := SRSaufVoyelle(sIn,'in','4');

// remplacement du sch
Sin := searchReplace(sIn,'sch','5');

// remplacement du s si précédé et suivi d'une voyelle ou son (1 à 4)
sin := SRSauf2Voyelle(sIn,'s','z');

// remplacement des groupes de 2 lettres divers
Sin := searchReplace(sIn,'oe','e');
Sin := searchReplace(sIn,'eu','e');
Sin := searchReplace(sIn,'au','o');
Sin := searchReplace(sIn,'oi','2');
Sin := searchReplace(sIn,'oy','2');
Sin := searchReplace(sIn,'ou','3');
Sin := searchReplace(sIn,'ch','5');
Sin := searchReplace(sIn,'sh','5');
Sin := searchReplace(sIn,'ss','s');
Sin := searchReplace(sIn,'sc','s');

// remplacement du c par s s'il est suivi d'un e ou d'un i
Sin := searchReplace(sIn,'ce','se');
Sin := searchReplace(sIn,'ci','si');

// remplacement divers
Sin := searchReplace(sIn,'c','k');
Sin := searchReplace(sIn,'q','k');
Sin := searchReplace(sIn,'qu','k');

Sin := searchReplace(sIn,'ga','ka');
Sin := searchReplace(sIn,'go','ko');
Sin := searchReplace(sIn,'gu','ku');
Sin := searchReplace(sIn,'gy','ky');
Sin := searchReplace(sIn,'g2','k2');
Sin := searchReplace(sIn,'g1','k1');
Sin := searchReplace(sIn,'g3','k3');

Sin := searchReplace(sIn,'a','o');
Sin := searchReplace(sIn,'d','t');
Sin := searchReplace(sIn,'p','t');
Sin := searchReplace(sIn,'j','g');
Sin := searchReplace(sIn,'b','f');
Sin := searchReplace(sIn,'v','f');
Sin := searchReplace(sIn,'m','n');

// suppression des lettres dupliquées
let := copy(sIn,1,1);
sIn2 := let;
for i := 2 to length(Sin)
do
begin
  if sIn[i] = let
  then
      continue;
  let := sIn[i];
  Sin2 := Sin2 + sIn[i];
end;
sIn := sIn2;

// suppression des terminaisons
sIn2 := copy(sIn,length(sIn),1);
if (sIn2 = 't') or (sIn2 = 'x') or (sIn2 = 's') or (sIn2 = 'z')
then
    sIn := copy(sIn,1,length(sIn)-1);

// suppression des caractères non autorisés
j := 10;
for i := 1 to length(sIn)
do
begin
  if j<1
  then
      break;
  for k:=0 to 21
  do
    if sIn[i] = carPhon[k]
    then
    begin
         sout[j] := k;
         j := j-1;
    end;
end;

// conversion en flottant
result := 0.0;
for j := 10 downTo 1
do
  result := result+sout[j]*pow(j-1,22);

end;

end.

Implémentation du soundex en Perl dûe à : Jean-Marc Pennel

fichier *.pm

 
Sélectionnez
package Soundex_fr;

require Exporter;
use strict;
use locale;

our $VERSION = 'v1.0.0';
our @ISA = qw(Exporter);
our @EXPORT = qw(soundex_fr);

# $soundex_nocode est utile pour indiquer le soundex d'un mot vide
# Par défaut on retourne undef mais vous pouvez préférer 'ZZZZ' ou 'NULL'

our $soundex_nocode = undef;

sub soundex_fr {
 my @a = @_;
 my $s;

 push(@a, '') unless @a;  ## Pas de paramètre d'appel

 foreach (@a) {
  if ($_ eq '') {
   $_ = $soundex_nocode;
   next;
  }

  # On prepare la chaine : etapes 1, 2, 3, 4
  # 1. Elimine les blancs ˆ droite et ˆ gauche du nom
  s/^\s+//;
  s/\s+$//; 

  # 2. Converti le nom en majuscule
  $_ = uc($_); 

  # 3. Converti les lettres accentuées et le c cédille en lettres non accentuées
  # NB : les lettres accentuées ne sont pas capitalisées :-(
  tr/\xE0-\xE6\xE7\xE8-\xEB\xEC-\xEF\xF1\xF2-\xF6\xF9-\xFC\xFD\xFF/AAAAAAACEEEEIIIINOOOOOUUUUYY/;
  tr/\xC0-\xC6\xC7\xC8-\xCB\xCC-\xCF\xD1\xD2-\xD6\xD9-\xDC\xDD/AAAAAAACEEEEIIIINOOOOOUUUUY/;

  # 4. Elimine tous les autres symboles 
  tr/A-Z//cd;

  # Chaîne de longeur 1
  next if (length($_) == 1);

  # Etape 5 : on remplace les consonnances primaires
  s/GUI/KI/g;
  s/GUE/KE/g;
  s/GA/KA/g;
  s/GO/KO/g;
  s/GU/K/g;
  s/CA/KA/g;
  s/CO/KO/g;
  s/CU/KU/g;
  s/Q/K/g;
  s/CC/K/g;
  s/CK/K/g;

  # Etape 6 : on remplace les voyelles par A, sauf le Y et la première lettre
  s/^(.)(.*)$/$2/; # le premier caractère dans $1, le reste dans $_
  tr/EIOU/AAAA/;
  $_ = $1 . $_;

  # Etape 7 : on remplace les préfixes
  s/^KN/NN/;
  s/^(PH|PF)/FF/;
  s/^MAC/MCC/;
  s/^SCH/SSS/;
  s/^ASA/AZA/;

  # Etape 8 : on conserve la première lettre 
  # et on fait les remplacements complémentaires
  s/^(.)(.*)$/$2/; # le premier caractère dans $1, le reste dans $_
  $s = $1;   # conserve le premier caractere
  s/KN/NN/;
  s/(PH|PF)/FF/;
  s/MAC/MCC/;
  s/SCH/SSS/;
  s/ASA/AZA/;
  $_ = $s . $_;

  # Etape 9 : suppression des H sauf CH ou SH
  s/CH/C@/g; s/SH/S@/g;
  s/H//;
  s/C@/CH/g; s/S@/SH/g;

  # Etape 10 : suppression des Y sauf précédés d'un A
  s/AY/A@/g; 
  s/Y//;
  s/A@/AY/g;

  # Etape 11 : on supprime les terminaisons A, T, D, S
  s/[ATDS]$//;

  # Etape 12 : suppression de tous les A sauf en tête
  s/^(.)(.*)$/$2/; # le premier caractère dans $1, le reste dans $_
  $s = $1;
  s/A//g;
  $_ = $s . $_;

  # Etape 13 : on supprime les lettres répétitives
  my @ac = split(//);
  $_ = '';
  for (my $i=0; $i < $#ac; $i++) {
    $_ .= $ac[$i] unless ($ac[$i] eq $ac[$i + 1]);
  }
  $_ .= $ac[$#ac];

  # Etape 14 : on ne retient que 4 caractères
  s/^(.{1,4}).*$/$1/;

 }

 wantarray ? @a : shift @a;
}

1;
__END__

=head1 NAME

Text::Soundex_fr - Soundex adapté au fran?ais

=head1 UTILISATION de Soundex_fr

 use Soundex_fr;

 $Soudex_fr::soundex_nocode = 'NULL';  # le soundex d'un mot vide

 $sound  = soundex_fr($word);
 @sounds = soundex_fr(@words);

=head1 DESCRIPTION

Algorithme décrit par Frédéric Bouchard <brouardf@club-internet.fr>

http://sqlpro.multimania.com/Soundex/SQL_AZ_soundex.htm

Soundex_fr est un algorithme francisé du Soundex, et dérivé de l'algorithme décrit dans le livre de 
Joe Celko - SQL avancé , parue en 1995 chez Thomson International Publishing. Il repose sur l'algorithme 
de Gus Baird (Georgia Tech) énoncé en page 85. 

Contrairement au précédent qui ne fait appel qu'à des chiffres à l'exception du premier caractère, cette 
nouvelle version conserve la plupart des lettres. En comparant les deux versions, on trouve, pour la 
première un nombre de combinaisons possibles de 26x10x10x10 = 26 000 alors que dans cette version améliorée 
le nombre de combinaisons différentes monte jusqu'aux environs de 20x20x20x20 = 160000 
Il se révèle donc plus performant dans de nombreux cas, c'est à dire qu'il permet de sélectionner moins 
d'occurrence lors des recherches avec le même encombrement de 4 caractères. 

=head1 AUTEUR

Jean-Marc Pennel <jmp@noos.fr<
http://www.suricate.net/

=cut

fichier *.pl

 
Sélectionnez
use Soundex_fr;
use strict;

my $mot = 'Bernard';
my @mots = ('Martin', 'Michel', 'Jean-Marc', 'Frédéric', 'Valérie');

print "\nSoundex_fr test :\n";

print "Test 1 : $mot => ";
print soundex_fr($mot), "\n";

print "Test 2 : (  ", (map {$_ .= '  '} @mots), ") => ( ";
print map {$_ .= '  '} soundex_fr(@mots);
print ") \n";

print "Test 3 : avec un mot vide ou pas d'argument, doit retourner 'NULL' => ";
$Soundex_fr::soundex_nocode = "NULL";
print soundex_fr(), "\n";

print "Fin du test.";

L'implémentation de la fonction phonex sous Oracle en PL/SQL. Une version dûe à Julien Vauconsant, modifiée par Sébastien MICHEL alias UbiK ()

 
Sélectionnez
rem   ***************************************************************
rem   *                                                           *
rem   *                      phonex.sql                             *
rem   *                                                             *
rem   *                   *
rem   *  Ce script créé 2 tables et une fonction  Phonex dans le    *
rem   *  même schéma .                                              *
rem   *  Pensez à donner le privilège d'execution de la fonction    *
rem   *  aux autres user .                                          *
rem   *  Cette fonction fonctionne comme un SOUNDEX amélioré.       *
rem   *                                                             *
rem   *  Elle est due aux travaux de Monsieur FREDERIC BROUARD      *
rem   *  alias SQLPro qui l'a développé sous Delphi .               *
rem   *  (http://sqlpro.developpez.com/Soundex/SQL_AZ_soundex.html) *
rem   *  pour obtenir les sources et + amples infos .               *
rem   *  Merci à lui de m'avoir permis d'effectuer ce portage en    *
rem   *  PLS/SQL :)                                                 *
rem   *            *
rem   *  Cette fonction Oracle est entièrement libre de droit, vous *
rem   *  pouvez l'utiliser sans aucune limite ni restriction,       *
rem   *  modifier les sources a votre convenance etc ... si vous    *
rem   *  l'améliorez je veux bien etre tenu au courant ;)           *
rem   *                                                             *
rem   *  PS : Libre a vous de passer par 2 tables ou de créer un    *
rem   *  type varray pour l'occasion . Néanmoins le fait de passer  *
rem   *  par 2 tables pour stocker les types de sons assure une     *
rem   *  compatibilité dès la version 7.3 d'Oracle !                *
rem   *=============================================================*
rem   *        Auteur : Julien Vauconsant alias UbiK             *
rem   *             jvauconsant@multilignes.fr                      *
rem   *=============================================================*
rem   *    Créé le 23/12/2002 ~~~~~~ Dernière modif le 26/12/2002   *
rem   *                                                             *
rem   *         System (création et tests) : Oracle 8.1.7.3         *
rem   ***************************************************************
 
 
create table son ( 
son_aia varchar2(4), 
son_aie varchar2(4), 
son_aii varchar2(4), 
son_aio varchar2(4), 
son_aiu varchar2(4));

insert into son(son_aia,son_aie,son_aii,son_aio,son_aiu) values('aina','aine','aini','aino','ainu');
insert into son(son_aia,son_aie,son_aii,son_aio,son_aiu) values('eina','eine','eini','eino','einu');
insert into son(son_aia,son_aie,son_aii,son_aio,son_aiu) values('aima','aime','aimi','aimo','aimu');
insert into son(son_aia,son_aie,son_aii,son_aio,son_aiu) values('eima','eime','eimi','eimo','eimu');
 

create table carphon ( 
tabcarphon varchar2(1),
codecarphon number);

insert into carphon(tabcarphon,codecarphon) values('1',1);
insert into carphon(tabcarphon,codecarphon) values('2',2);
insert into carphon(tabcarphon,codecarphon) values('3',3);
insert into carphon(tabcarphon,codecarphon) values('4',4);
insert into carphon(tabcarphon,codecarphon) values('5',5);
insert into carphon(tabcarphon,codecarphon) values('e',6);
insert into carphon(tabcarphon,codecarphon) values('f',7);
insert into carphon(tabcarphon,codecarphon) values('g',8);
insert into carphon(tabcarphon,codecarphon) values('h',9);
insert into carphon(tabcarphon,codecarphon) values('i',10);
insert into carphon(tabcarphon,codecarphon) values('k',11);
insert into carphon(tabcarphon,codecarphon) values('l',12);
insert into carphon(tabcarphon,codecarphon) values('n',13);
insert into carphon(tabcarphon,codecarphon) values('o',14);
insert into carphon(tabcarphon,codecarphon) values('r',15);
insert into carphon(tabcarphon,codecarphon) values('s',16);
insert into carphon(tabcarphon,codecarphon) values('t',17);
insert into carphon(tabcarphon,codecarphon) values('u',18);
insert into carphon(tabcarphon,codecarphon) values('w',19);
insert into carphon(tabcarphon,codecarphon) values('x',20);
insert into carphon(tabcarphon,codecarphon) values('y',21);
insert into carphon(tabcarphon,codecarphon) values('z',22);
commit;

/************** CREATION DE LA FONCTION PHONEX **************/

CREATE OR REPLACE FUNCTION PHONEX (l_in in varchar2)
return float is

cursor c1 is (select son_aia, son_aie, son_aii, son_aio, son_aiu from son);
cursor c2 is (select tabcarphon,codecarphon from carphon);

custom_error exception;
SonAi c1%rowtype;
KPhon c2%rowtype;
v_string varchar2(4000);
result float;
i integer;
p integer;
j integer;
cpt integer;
sortie integer;
letter char(1);
v_string_bis varchar2(4000);

BEGIN

-- ouverture du curseur
open c1;
-- initialisation des variables
v_string := replace(l_in,chr(32),null); -- suppression des espaces
p := 1;
cpt:=0;
sortie := 6; -- condition de sortie=0
result:=0.0;
j:= length(v_string);

-- chaine vide en entrée
if (v_string is null) then
  result:=0.0;
end if;

-- passage en minuscule de la chaine en entrée
v_string := lower(v_string);

-- remplacement des ç par des ss
v_string := replace(v_string,'ç','ss');
v_string := replace(v_string,'Ç','ss');

-- remplacement des y par des i
v_string := replace(v_string,'y','i');

-- remplacement des e accentués par y (son et)
v_string := translate(v_string,'ÉÈÊËéèêë','yyyyyyyy');

-- remplacement des lettres accentués
v_string := translate(v_string,'ÀÄÂâäàÇçÉÈÊËéèêëÏÎïîÖÔöôÜÛÙüûù','aaaaaacceeeeeeeeiiiioooouuuuuu');

-- suppression des h muets ...
-- ... en premiere ou derniere position de chaine ...

while (substr(v_string,1,1)='h' or substr(v_string,j,1)='h') loop
  v_string := rtrim(ltrim(v_string,'h'),'h');
end loop;
-- ... autres cas
for i in 2..j
loop
  if ( (substr(v_string,i,1)='h') and ( substr(v_string,i-1,1) not in ('c','s','p') ) ) then
    v_string := substr(v_string,1,i-1)||substr(v_string,i+1);
 j:=j-1;
  end if;
end loop;

-- remplacement des er par des ez en fin de mot
-- BOUCHEZ et BOUCHER
if substr(v_string,length(v_string)-1,2) = 'er' then
   v_string := substr(v_string,1,length(v_string)-2) || 'ez';
end if;

-- remplacement des ss par des sse en fin de mot
-- choultess et choultesse
if substr(v_string,length(v_string)-1,2) = 'ss' then
   v_string := substr(v_string,1,length(v_string)-2) || 'sse';
end if;

-- remplacement des ph par des f
v_string := replace(v_string,'ph','f');

-- remplacement des g sonnant k
v_string := replace(v_string,'gan','kan');
v_string := replace(v_string,'gain','kain');
v_string := replace(v_string,'gam','kam');
v_string := replace(v_string,'gaim','kaim');

-- remplacement du son AI
loop
  fetch c1 into SonAI;
  exit when c1%notfound;
  v_string := replace(v_string,SonAi.son_aia,'yna');
  v_string := replace(v_string,SonAi.son_aie,'yne');
  v_string := replace(v_string,SonAi.son_aii,'yni');
  v_string := replace(v_string,SonAi.son_aio,'yno');
  v_string := replace(v_string,SonAi.son_aiu,'ynu');
end loop;
close c1;

-- remplacement des groupes de 3 lettres
v_string := replace(v_string,'eau','o');
v_string := replace(v_string,'oua','2');
v_string := replace(v_string,'ein','4');
v_string := replace(v_string,'ain','4');
v_string := replace(v_string,'eim','4');
v_string := replace(v_string,'aim','4');

-- remplacement du son é
v_string := replace(v_string,'ai','y');
v_string := replace(v_string,'ei','y');
v_string := replace(v_string,'er','yr');
v_string := replace(v_string,'ess','yss');
v_string := replace(v_string,'et','yt');
v_string := replace(v_string,'ez','yz');

v_string := replace(v_string,'oe','e');
v_string := replace(v_string,'eu','e');
v_string := replace(v_string,'au','o');

-- remplacement des groupes de 2 lettres sauf si le groupe est suivi d'une voyelle ou d'un son 1 à 4
while (sortie>0)
loop
  -- an
  p := instr(v_string,'an');
  if(p=0) then
    sortie := sortie-1;
  else if substr(v_string,p+2,1) not in ('a','e','i','o','u','y','1','2','3','4') then
    v_string := substr(v_string,1,p-1)||'1'||substr(v_string,p+2);
  else if length(v_string) = p+1 then
    v_string := substr(v_string,1,p-1)||'1';
    end if;
   end if;
  end if;
  -- am
  p := instr(v_string,'am');
  if(p=0) then
    sortie := sortie-1;
  else if substr(v_string,p+2,1) not in ('a','e','i','o','u','y','1','2','3','4') then
    v_string := substr(v_string,1,p-1)||'1'||substr(v_string,p+2);
  else if length(v_string) = p+1 then
    v_string := substr(v_string,1,p-1)||'1';
    end if;
   end if;
  end if;
  -- en
  p := instr(v_string,'en');
  if(p=0) then
    sortie := sortie-1;
  else if substr(v_string,p+2,1) not in ('a','e','i','o','u','y','1','2','3','4') then
    v_string := substr(v_string,1,p-1)||'1'||substr(v_string,p+2);
  else if length(v_string) = p+1 then
    v_string := substr(v_string,1,p-1)||'1';
    end if;
   end if;
  end if;
  -- em
  p := instr(v_string,'em');
  if(p=0) then
    sortie := sortie-1;
  else if substr(v_string,p+2,1) not in ('a','e','i','o','u','y','1','2','3','4') then
    v_string := substr(v_string,1,p-1)||'1'||substr(v_string,p+2);
  else if length(v_string) = p+1 then
    v_string := substr(v_string,1,p-1)||'1';
    end if;
   end if;
  end if;
  -- in
  p := instr(v_string,'in');
  if(p=0) then
    sortie := sortie-1;
  else if substr(v_string,p+2,1) not in ('a','e','i','o','u','y','1','2','3','4') then
    v_string := substr(v_string,1,p-1)||'4'||substr(v_string,p+2);
  else if length(v_string) = p+1 then
    v_string := substr(v_string,1,p-1)||'4';
    end if;
   end if;
  end if;
  -- un
  p := instr(v_string,'un');
  if(p=0) then
    sortie := sortie-1;
  else if substr(v_string,p+2,1) not in ('a','e','i','o','u','y','1','2','3','4') then
    v_string := substr(v_string,1,p-1)||'4'||substr(v_string,p+2);
  else if length(v_string) = p+1 then
    v_string := substr(v_string,1,p-1)||'4';
    end if;
   end if;
  end if;
end loop;

-- remplacement du sch
v_string := replace(v_string,'sch','5');

-- remplacement du s si précédé ET suivi d'une voyelle ou d'un son 1 à 4
for i in 2..length(v_string)
loop
  if (substr(v_string,i,1)='s') then
    if ( (substr(v_string,i-1,1) ) in ('a','e','i','o','u','y','1','2','3','4') ) AND
    ( (substr(v_string,i+1,1) ) in ('a','e','i','o','u','y','1','2','3','4') ) then
      v_string := substr(v_string,1,i-1)||'z'||substr(v_string,i+1);
 end if;
  end if;
end loop;

-- Remplacement de groupes de 2 lettres divers
v_string := replace(v_string,'oe','e');
v_string := replace(v_string,'eu','e');
v_string := replace(v_string,'au','o');
v_string := replace(v_string,'oi','2');
v_string := replace(v_string,'oy','2');
v_string := replace(v_string,'ou','3');
v_string := replace(v_string,'ch','5');
v_string := replace(v_string,'sh','5');
v_string := replace(v_string,'ss','s');
v_string := replace(v_string,'sc','s');

-- Remplacement du CHU par CHOU
v_string := replace(v_string,'5u','53');

-- Remplacement du c par s s'il est suivi d'un e ou d'un i
v_string := replace(v_string,'ce','se');
v_string := replace(v_string,'ci','si');

/************* Remplacements divers *************/

v_string := replace(v_string,'c','k');
v_string := replace(v_string,'qu','k');
v_string := replace(v_string,'q','k');

v_string := replace(v_string,'ga','ka');
v_string := replace(v_string,'go','ko');
v_string := replace(v_string,'gu','ku');
v_string := replace(v_string,'gy','ky');
v_string := replace(v_string,'g2','k2');
v_string := replace(v_string,'g1','k1');
v_string := replace(v_string,'g3','k3');

v_string := replace(v_string,'a','o');
v_string := replace(v_string,'d','t');
v_string := replace(v_string,'p','t');
v_string := replace(v_string,'j','g');
v_string := replace(v_string,'b','f');
v_string := replace(v_string,'v','f');
v_string := replace(v_string,'m','n');

-- Suppression des lettres dupliquées
letter := substr(v_string,1,1);
v_string_bis := letter;
for i in 2..length(v_string)
loop
  if (substr(v_string,i,1) != letter) then
    letter := substr(v_string,i,1);
 v_string_bis:= v_string_bis||letter;
  end if;
end loop;
v_string := v_string_bis;

-- Suppression des terminaisons
v_string_bis := substr(v_string,length(v_string),1);
if (v_string_bis in ('t','x','s','z') ) then
  v_string := substr(v_string,1,length(v_string)-1);
end if;

-- Conversion des caracteres en float
j := 10;
for i in 1..length(v_string)
loop
open c2;
  while j>1 loop
   fetch c2 into KPhon;
   exit when c2%notfound;
   if (substr(v_string,i,1) = KPhon.tabcarphon) then
  cpt:= cpt-1;
  result:=result+(KPhon.codecarphon*power(22,cpt));
  j := j-1;
   end if;
  end loop;
close c2;
end loop;

return result;

exception
when custom_error then
raise_application_error(-20100,'pb sur'||l_in);
end;

voici une implémentation en PHP de l'algo "soundex2" par F. Bouchery et qui implémente l'utilisation des expressions régulières :

 
Sélectionnez
function soundex2( $sIn )
{
   // Si il n'y a pas de mot, on sort immédiatement
   if ( $sIn === '' ) return '    ';
   // On met tout en minuscule
   $sIn = strtoupper( $sIn );
   // On supprime les accents
   $sIn = strtr( $sIn, 'ÂÄÀÇÈÉÊËŒÎÏÔÖÙÛÜ', 'AAASEEEEEIIOOUUU' );
   // On supprime tout ce qui n'est pas une lettre
   $sIn = preg_replace( '`[^A-Z]`', '', $sIn );
   // Si la chaîne ne fait qu'un seul caractère, on sort avec.
   if ( strlen( $sIn ) === 1 ) return $sIn . '   ';
   // on remplace les consonnances primaires
   $convIn = array( 'GUI', 'GUE', 'GA', 'GO', 'GU', 'CA', 'CO', 'CU', 'Q', 'CC', 'CK' );
   $convOut = array( 'KI', 'KE', 'KA', 'KO', 'K', 'KA', 'KO', 'KU', 'K','K', 'K' );
   $sIn = str_replace( $convIn, $convOut, $sIn );
   // on remplace les voyelles sauf le Y et sauf la première par A
   $sIn = preg_replace( '`(?<!^)[EIOU]`', 'A', $sIn );
   // on remplace les préfixes puis on conserve la première lettre
   // et on fait les remplacements complémentaires
   $convIn = array( '`^KN`', '`^(PH|PF)`', '`^MAC`', '`^SCH`', '`^ASA`', '`(?<!^)KN`', '`(?<!^)(PH|PF)`', '`(?<!^)MAC`',
                    '`(?<!^)SCH`','`(?<!^)ASA`' );
   $convOut = array( 'NN', 'FF', 'MCC', 'SSS', 'AZA', 'NN', 'FF', 'MCC', 'SSS', 'AZA' );
   $sIn = preg_replace( $convIn, $convOut, $sIn );
   // suppression des H sauf CH ou SH
   $sIn = preg_replace( '`(?<![CS])H`', '', $sIn );
   // suppression des Y sauf précédés d'un A
   $sIn = preg_replace( '`(?<!A)Y`', '', $sIn );
   // on supprime les terminaisons A, T, D, S
   $sIn = preg_replace( '`[ATDS]$`', '', $sIn );
   // suppression de tous les A sauf en tête
   $sIn = preg_replace( '`(?!^)A`', '', $sIn );
   // on supprime les lettres répétitives
   $sIn = preg_replace( '`(.)\1`', '$1', $sIn );
   // on ne retient que 4 caractères ou on complète avec des blancs
   return substr( $sIn . '    ', 0, 4);
}

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

Copyright © 2004 Frédéric Brouard. 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.