Commences par créer une base de données. (SQLite ira très bien. Regarde l'aide)
Crées ensuite une table dont chaque ligne contient le mot de ton dictionnaire et la codification Soundex suivant la requête ci-dessous.
Associe une clé champ qui contient la codification SoundEx suivant la requête ci-dessous.
Crées ensuite une boucle qui lit en entrée ton dictionnaire sous forme de fichier texte et qui transfère chacune des lignes dans la base de donnée SQLite aprés avoir calculer la codification SoundEx.
Le traitement est assez long car ton dictionnaire doit contenir environ 63000 mots.
N'en dit pas plus, tu trouveras le code que tu placeras dans un fichier include.
Code : Tout sélectionner
; Soundex Version 1.00
; Contributor : Falsam
;Soundex est un algorithme phonétique d'indexation de noms par leurs consonances
;L'objectif basique est que les noms ayant la même prononciation
;soient codés avec la même chaîne de manière à pouvoir trouver
;une correspondance entre eux malgré des différences mineures d'écriture.
;L'algorithme procède comme suit :
;Supprimer les éventuels 'espace' initiaux
;Mettre le mot en majuscule
;Garder la première lettre
;Conserver la première lettre de la chaîne.
;Supprimer toutes les occurrences des lettres : a, e, h, i, o, u, w, y (à moins que ce ne soit la première lettre du nom)
;Attribuer une valeur numérique aux lettres restantes de la manière suivante :
;Version pour l'anglais :
;1 = B, F, P, V
;2 = C, G, J, K, Q, S, X, Z
;3 = D, T
;4 = L
;5 = M, N
;6 = R
;Version pour le français :(Par defaut)
;1 = B, P
;2 = C, K, Q
;3 = D, T
;4 = L
;5 = M, N
;6 = R
;7 = G, J
;8 = X, Z, S
;9 = F, V
;Si deux lettres (ou plus) avec le même nombre sont adjacentes dans le nom d'origine,
;Renvoyer les quatre premiers octets complétés par des zéros.
;En effectuant cet algorithme, on obtient avec "Robert" et "Rupert" la même chaîne : "R163", tandis que "Rubin" donne "R150".
Enumeration
#Buffer
#RegExpr
EndEnumeration
Global FirstLetter.s ;Récupération de la 1er lettre du mot
Global xBuffer.s ;Copie du mot en cours de lecture avant dédoublonnage des lettres consécutives
Global i.l ;Indice de parcours du mot en cours de dédoublonnage.
Procedure.s Soundex(Buffer.s)
FirstLetter="" : xBuffer="" : i=0
;Supprimer les espaces
Buffer = ReplaceString(Buffer, " ", "")
;Mettre en majusule
Buffer = UCase(Buffer)
;Garder la premiere lettre
FirstLetter = Left(Buffer, 1)
Buffer=Right(Buffer,Len(Buffer)-1)
;Elimination des voyelles A,E,I,O,U,Y ainsi que H et W
CreateRegularExpression(#Buffer,"[A,E,I,O,U,Y,H,W,Â,Ä,À,È,É,Ê,Ë,Œ,Î,Ï,Ô,Ö,Ù,Û,Ü]")
Buffer=ReplaceRegularExpression(#Buffer,Buffer,"")
;Remplacer les lettres restantes par le chiffre associé (Code francophone)
;Remplacement de B, P par 1
CreateRegularExpression(#RegExpr,"[B,P]")
Buffer=ReplaceRegularExpression(#RegExpr,Buffer,"1")
;Remplacement de C, K, Q par 2
CreateRegularExpression(#RegExpr,"[C,K,Q]")
Buffer=ReplaceRegularExpression(#RegExpr,Buffer,"2")
;Remplacement de D, T par 3
CreateRegularExpression(#RegExpr,"[D,T]")
Buffer=ReplaceRegularExpression(#RegExpr,Buffer,"3")
;Remplacement de L par 4
CreateRegularExpression(#RegExpr,"[L]")
Buffer=ReplaceRegularExpression(#RegExpr,Buffer,"4")
;Remplacement de M, N par 5
CreateRegularExpression(#RegExpr,"[M,N,]")
Buffer=ReplaceRegularExpression(#RegExpr,Buffer,"5")
;Remplacement de R par 6
CreateRegularExpression(#RegExpr,"[R]")
Buffer=ReplaceRegularExpression(#RegExpr,Buffer,"6")
;Remplacement de G, J par 7
CreateRegularExpression(#RegExpr,"[G,J]")
Buffer=ReplaceRegularExpression(#RegExpr,Buffer,"7")
;Remplacement de S, X, Z par 8 (Le Ç devient aussi un S)
CreateRegularExpression(#RegExpr,"[Ç,S,X,Z]")
Buffer=ReplaceRegularExpression(#RegExpr,Buffer,"8")
;Remplacement de F, V par 9
CreateRegularExpression(#RegExpr,"[F,V]")
Buffer=ReplaceRegularExpression(#RegExpr,Buffer,"9")
;Supprimer les chiffres répétés (garder une seule occurence : 11 devient 1, 22 devient 2, etc ....)
For i=1 To Len(Buffer)
car.s=Mid(Buffer,i,1)
If FindString(xBuffer,Mid(Buffer,i,1),1)=0
xBuffer=xBuffer+car
EndIf
Next i
Buffer=xBuffer
;Renvoyer les quatre premiers octets complétés par des zéros.
ProcedureReturn LSet(FirstLetter+Buffer,4,"0")
EndProcedure
