*!* Objet : Implémention d'une fonction de reconnaissance phonétique
*!* Auteur : C.Chenavier
*!* Version : 1.00 - 14/07/2003
*!*
*!* Algorithme d'origine par Frédéric BROUARD (31/3/99) avec l'aide
*!* de Florence MARQUIS, orthophoniste pour la mise au point.
*!* Voir : http://sqlpro.developpez.com/cours/soundex/
*!*
*!* Améliorations apportées par Monique Kijko (Alfa informatique)
*!* et Christophe Chenavier (Corwin)
FUNCTION Phonex
LPARAMETER cString
LOCAL I, c1, c2, cResultat, cLettre, cCar, cGroupe
M.c1="ÂÀÄÅÁÃÉÊÈËÎÏÌÍÔÖÒÓÕÛÜÙÚÇ-YÝÑ"
M.c2="AAAAAAYYYYIIIIOOOOOUUUUS IIN"
** É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 Y par des I
M.cString = STRTRAN(CHRTRAN(UPPER(ALLTRIM(M.cString)), M.c1, M.c2), ' ')
** Remplacer le C par un S s'il est suivi d'un E ou d'un I ou d'un Y
M.cString = STRTRAN(M.cString, "CE", "SE")
M.cString = STRTRAN(M.cString, "CI", "SI")
M.cString = STRTRAN(M.cString, "CY", "SY")
** Replacer Œ par E
M.cString = CHRTRAN(M.cString, 'Œ', 'E')
** Remplacer PH par F
M.cString = STRTRAN(M.cString, "PH", "F")
** Supprimer les H qui ne sont pas précédés de C ou de S
M.cString = STRTRAN(M.cString, "CH", "$C$")
M.cString = STRTRAN(M.cString, "SH", "$S$")
M.cString = STRTRAN(M.cString, "H")
M.cString = STRTRAN(M.cString, "$C$", "CH")
M.cString = STRTRAN(M.cString, "$S$", "SH")
** Remplacer les groupes de lettres suivantes :
M.cString = STRTRAN(M.cString, "GAN", "KAN")
M.cString = STRTRAN(M.cString, "GAM", "KAM")
M.cString = STRTRAN(M.cString, "GAIN", "KAIN")
M.cString = STRTRAN(M.cString, "GAIM", "KAIM")
** Remplacer les occurrences suivantes,
** si elles sont suivies par une lettre a, e, i, o, u ou y :
FOR I = 1 TO 5
M.cLettre = SUBSTR("AEIOUY", I, 1)
M.cString = STRTRAN(M.cString, "AIN"+M.cLettre, "YN"+M.cLettre)
M.cString = STRTRAN(M.cString, "EIN"+M.cLettre, "YN"+M.cLettre)
M.cString = STRTRAN(M.cString, "AIM"+M.cLettre, "YN"+M.cLettre)
M.cString = STRTRAN(M.cString, "EIM"+M.cLettre, "YN"+M.cLettre)
ENDFOR
** Remplacer les groupes de 3 lettres (sons 'o', 'oua', 'ein') :
M.cString = STRTRAN(M.cString, "EAU", 'O')
M.cString = STRTRAN(M.cString, "OUA", '2')
M.cString = STRTRAN(M.cString, "EIN", '4')
M.cString = STRTRAN(M.cString, "AIN", '4')
M.cString = STRTRAN(M.cString, "EIM", '4')
M.cString = STRTRAN(M.cString, "AIM", '4')
** Remplacer le son ‘é’ par 'y':
*M.c1="ÉÈÊ"
*M.c2="YYY"
*M.cString = CHRTRAN(M.cString, M.c1, M.c2)
M.cString = STRTRAN(M.cString, "AI", 'Y')
M.cString = STRTRAN(M.cString, "EI", 'Y')
M.cString = STRTRAN(M.cString, "ER", "YR")
M.cString = STRTRAN(M.cString, "ESS", "YSS")
M.cString = STRTRAN(M.cString, "ET", "YT")
M.cString = STRTRAN(M.cString, "EZ", "YZ")
** Remplacer les groupes de 2 lettres suivantes (son ‘an’ et ‘in’),
** sauf s’ils sont suivis par une lettre a, e, i, o, u ou un son 1 à 4 :
FOR I = 1 TO 5
M.cGroupe = SUBSTR("ANAMENEMIN", (I-1)*2+1, 2)
M.cString = STRTRAN(M.cString, M.cGroupe+'A', "$1$")
M.cString = STRTRAN(M.cString, M.cGroupe+'E', "$2$")
M.cString = STRTRAN(M.cString, M.cGroupe+'I', "$3$")
M.cString = STRTRAN(M.cString, M.cGroupe+'O', "$4$")
M.cString = STRTRAN(M.cString, M.cGroupe+'U', "$5$")
M.cString = STRTRAN(M.cString, M.cGroupe+'1', "$6$")
M.cString = STRTRAN(M.cString, M.cGroupe+'2', "$7$")
M.cString = STRTRAN(M.cString, M.cGroupe+'3', "$8$")
M.cString = STRTRAN(M.cString, M.cGroupe+'4', "$9$")
M.cString = STRTRAN(M.cString, M.cGroupe, IIF(I<5, '1', '4'))
M.cString = STRTRAN(M.cString, "$1$", M.cGroupe+'A')
M.cString = STRTRAN(M.cString, "$2$", M.cGroupe+'E')
M.cString = STRTRAN(M.cString, "$3$", M.cGroupe+'I')
M.cString = STRTRAN(M.cString, "$4$", M.cGroupe+'O')
M.cString = STRTRAN(M.cString, "$5$", M.cGroupe+'U')
M.cString = STRTRAN(M.cString, "$6$", M.cGroupe+'1')
M.cString = STRTRAN(M.cString, "$7$", M.cGroupe+'2')
M.cString = STRTRAN(M.cString, "$8$", M.cGroupe+'3')
M.cString = STRTRAN(M.cString, "$9$", M.cGroupe+'4')
ENDFOR
** Remplacer les S par des Z s’ils sont précédés et suivis
** des lettres a, e, i, o, u, y ou d’un son 1 à 4
M.cResultat = LEFT(M.cString,1)
FOR I = 2 TO LEN(M.cString)-1
M.cLettre = SUBSTR(M.cString, I, 1)
IF M.cLettre = 'S' AND ;
AT(RIGHT(M.cResultat,1), "AEIOUY1234") > 0 AND ;
AT(SUBSTR(M.cString, I+1, 1), "AEIOUY1234") > 0
M.cResultat = M.cResultat + 'Z'
ELSE
M.cResultat = M.cResultat + M.cLettre
ENDIF
ENDFOR
M.cResultat = M.cResultat + RIGHT(M.cString,1)
** Remplacer les groupes de 2 lettres suivants
M.cResultat = STRTRAN(M.cResultat, "OE", 'E')
M.cResultat = STRTRAN(M.cResultat, "EU", 'E')
M.cResultat = STRTRAN(M.cResultat, "AU", 'O')
M.cResultat = STRTRAN(M.cResultat, "OI", '2')
M.cResultat = STRTRAN(M.cResultat, "OY", '2')
M.cResultat = STRTRAN(M.cResultat, "OU", '3')
** remplacer les groupes de lettres suivants
M.cResultat = STRTRAN(M.cResultat, "CH", '5')
M.cResultat = STRTRAN(M.cResultat, "SCH", '5')
M.cResultat = STRTRAN(M.cResultat, "SH", '5')
M.cResultat = STRTRAN(M.cResultat, "SS", 'S')
M.cResultat = STRTRAN(M.cResultat, "SC", 'S')
** Remplacer les lettres ou groupe de lettres suivants
M.cResultat = STRTRAN(M.cResultat, "QU", 'K')
M.cResultat = STRTRAN(M.cResultat, "GU", 'K')
M.cResultat = STRTRAN(M.cResultat, "GA", "KA")
M.cResultat = STRTRAN(M.cResultat, "GO", "KO")
M.cResultat = STRTRAN(M.cResultat, "GY", "KY")
M.cResultat = STRTRAN(M.cResultat, "G1", "K1")
M.cResultat = STRTRAN(M.cResultat, "G2", "K2")
M.cResultat = STRTRAN(M.cResultat, "G3", "K3")
** Remplacer les lettres suivantes :
M.c1="CQDJBVM"
M.c2="KKTGPFN"
M.cResultat = CHRTRAN(M.cResultat, M.c1, M.c2)
** Supprimer les lettres dupliquées
M.cString = M.cResultat
M.cLettre = LEFT(M.cString, 1)
M.cResultat = M.cLettre
FOR I = 2 TO LEN(M.cString)
M.cCar = SUBSTR(M.cString, I, 1)
IF M.cCar <> M.cLettre
M.cLettre = M.cCar
M.cResultat = M.cResultat + M.cLettre
ENDIF
ENDFOR
** Supprimer le 'E' final précédant un 'X'
IF RIGHT(M.cResultat,2) = "XE"
M.cResultat = LEFT(M.cResultat, LEN(M.cResultat)-1)
ENDIF
** Supprimer les terminaisons suivantes : T, P, X, S, Z
** si elles ne sont pas précédées d'un E
IF LEN(M.cResultat) > 1 AND SUBSTR(M.cResultat, LEN(M.cResultat)-1, 1) <> 'E' AND ;
INLIST(RIGHT(M.cResultat,1), 'T', 'P', 'X', 'S', 'Z')
M.cResultat = LEFT(M.cResultat, LEN(M.cResultat)-1)
ENDIF
RETURN M.cResultat
|
Excellent !
belle contribution