*--------------------------------------------------------------------------*
* SoundEx francisé
procedure SoundEx2(p_mot as String) as String
local v_mot, v_i
*---> 1 Éliminer les blancs à droite et à gauche du nom
*---> 2 Convertir le nom en minuscules
*---> 3 Convertir les lettres accentuées et le c cédille en lettres non accentuées
v_mot = lower(alltrim(p_mot))
v_mot = chrtran(v_mot, "àâäéèëêîïôöùûüç", "aaaeeeeiioouuuc")
v_mot = upper(v_mot)
*---> 4 Eliminer les blancs et les tirets
for v_i=1 to len(v_mot)
if v_i > len(v_mot)
exit
endif
if !between(asc(substr(v_mot, v_i, 2)), 65, 90)
v_mot = stuff(v_mot, v_i, 1, "")
v_i = v_i - 1
endif
next
*---> 5 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
v_mot = strtran(v_mot, "GUI", "KI")
v_mot = strtran(v_mot, "GUE", "KE")
v_mot = strtran(v_mot, "GA", "KA")
v_mot = strtran(v_mot, "GO", "KO")
v_mot = strtran(v_mot, "GU", "K")
v_mot = strtran(v_mot, "CA", "KA")
v_mot = strtran(v_mot, "CO", "KO")
v_mot = strtran(v_mot, "CU", "KU")
v_mot = strtran(v_mot, "Q", "K")
v_mot = strtran(v_mot, "CC", "K")
v_mot = strtran(v_mot, "CK", "K")
*---> 6 Remplacer toutes les voyelles sauf le Y par A exceptée s’il y a un A en tête
v_mot = left(v_mot, 1) + chrtranc(substr(v_mot,2), "EIOU", "AAAA")
*---> 7 Remplacer les préfixes suivants par leur correspondance :
* MAC MCC
* ASA AZA
* KN NN
* PF FF
* SCH SSS
* PH FF
v_mot = strtran(v_mot, "MAC", "MCC")
v_mot = strtran(v_mot, "ASA", "AZA")
v_mot = strtran(v_mot, "KN", "NN")
v_mot = strtran(v_mot, "PF", "FF")
v_mot = strtran(v_mot, "SCH", "SSS")
v_mot = strtran(v_mot, "PH", "FF")
*---> Supprimer les H sauf s’ils sont précédés par C ou S
for v_i=1 to len(v_mot)
if v_i > len(v_mot)
exit
endif
if substr(v_mot, v_i, 1) == "H" and !(substr(v_mot, v_i - 1, 1) $ "CS")
v_mot = stuff(v_mot, v_i, 1, "")
v_i = v_i - 1
endif
next
*---> Supprimer les Y sauf s’il est précédé d’un A
for v_i=1 to len(v_mot)
if v_i > len(v_mot)
exit
endif
if substr(v_mot, v_i, 1) == "Y" and substr(v_mot, v_i - 1, 1) <> "A"
v_mot = stuff(v_mot, v_i, 1, "")
v_i = v_i - 1
endif
next
*---> Supprimer les terminaisons suivantes A, T, D et S
do while right(v_mot, 1) $ "ATDS"
v_mot = left(v_mot, len(v_mot) - 1)
enddo
*---> Enlever tous les A sauf le A de tête s’il y en a un
v_mot = left(v_mot,1) + strtran(substr(v_mot,2), "A")
*---> Enlever toutes les sous chaînes de lettre répétitives
for v_i=1 to len(v_mot)
if v_i > len(v_mot)
exit
endif
if substr(v_mot, v_i, 1) == substr(v_mot, v_i - 1, 1)
v_mot = stuff(v_mot, v_i, 1, "")
v_i = v_i - 1
endif
next
*---> Conserver les 4 premiers caractères du mot et si besoin le compléter avec des blancs pour obtenir 4 caractères
v_mot = padr(v_mot, 4)
return v_mot
endproc && SoundEx2
|
Retour à la liste
France
Fiche personnelle
Note des membres
Niveau
débutant