ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

SOUNDEX() francisé   



L'auteur

Anatole
France France
Membre Simple
# 0000000002
enregistré le 12/10/2004

Fiche personnelle


Note des membres
pas de note

Contributions > 01 - PRG : Programmation

SOUNDEX() francisé
# 0000000320
ajouté le 18/05/2006 12:51:26 et modifié le 05/07/2006
consulté 7842 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
VFP 6.0

Description
Voici une procédure qui contrairement à la fonction SOUNDEX() est adaptée au français.
Code source :
*--------------------------------------------------------------------------*
* SoundEx francisé
procedure SoundEx2(p_mot as Stringas 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
Commentaires
Aucun commentaire enregistré ...

Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3