Dans le cadre de mon lexique de termes techniques, j'ai été amené à chercher, classer et associer des mots de provenances très diverses.
Ces recherches m'ont amenée à importer et vérifier un grand nombre de mots avec parfois des doublons stricts (chaînes de caractères identiques) mais aussi des mots mal orthographiés:
Un accent dans le mauvais sens, un espace en trop, une majuscule au lieu d'une minuscule, un s
en fin de mots quand ils sont au pluriel et il devient impossible d'associer ces mots entre eux ou de repérer les termes redondant.
Pour palier à ce problème, il était nécessaire de trouver un algorithme, une méthode permettant de comparer deux chaînes de caractères en trouvant le nombre de différences entre ces deux chaînes.
Après quelques recherches, mon choix s'est porté sur la distance de Levenshtein qui permet de mesurer le nombre de caractères qu'il faut ajouter, supprimer ou encore remplacer pour passer d'une chaîne à l'autre.
La distance de Levenshtein répond parfaitement à mon besoin mais a un défaut majeur: C'est LEEENNNT !
En effet, l'algorithme permettant de calculer la distance de Levenshtein est très gourmand en temps de calcul et compte tenu que le nombre de mots que je veux tester est en augmentation constante, la situation pour moi n'était plus tenable.
Il est donc devenu impératif pour moi de trouver une solution pour optimiser le nettoyage de ma liste de mots.
Après réflexion, j'en suis arrivée à cette évidence:
Il n'est pas nécessaire pour mon usage de connaître la distance de Levenshtein "totale" entre deux chaînes de caractères, il faut seulement évaluer la distance intermédiaire entre deux itérations de l'agorithme. Si cette distance "intermédiaire" dépasse un certain seuil (fixé par l'utilisateur), alors il n'est pas nécessaire de continuer le calcul. Cela permettra de discriminer plus vite les mots indésirables.
Je ne rentrerais pas dans le fonctionnement détaillé de l'algorithme de Levenshtein, cette section de la page Wikipédia Distance de Levenshtein le fera bien mieux. Mais a chaque étape (chaque ligne de la matrice D), on peut obtenir la distance minimum entre chaque étape.
Cette distance ne sera pas tout à fait exacte, il faudrait normalement prendre en compte les caractères à ajouter (Cf. explications). Mais à l'étape suivante, ces changements auront été pris en compte.
Que l'interruption du calcul de la distance se fasse à l'étape n ou n+1 n'a pas d'importance et n'aura pas une grande influence sur le temps de calcul final.
Une implémentation du calcul de la distance de Levenshtein possible est:
levenshtein :: Eq a => [a] -> [a] -> Int
levenshtein str1 str2 = last $ foldl transform [0 .. length str1] str2
where
transform ns@(n : ns1) c = scanl calc (n + 1) $ zip3 str1 ns ns1
where calc z (c1, x, y) = minimum [y + 1, z + 1, x + fromEnum (c1 /= c)]
Pour développer la nouvelle fonction, il suffit de remplacer la partie last $ foldl …
qui permet de récupérer le dernier élément de la dernière ligne des calculs de distance par une fonction qui permettrait de tester à chaque étape la distance minimum et de stopper les itérations le cas échéant.
Il faut donc une fonction qui tout comme foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
prend comme argument
La fonction à appliquer avec les bons arguments en entrée.
La valeur de départ (la première ligne de la matrice D.
Les valeurs à appliquer à chaque itération.
et retourne la valeur finale.
Ici la valeur sera de type Maybe Int
avec
Nothing
Si le test échoue et qu'il y a interruption en cours de route
Just b
Si la fonction réussie. La valeur retournée sera la distance de Levenshtein "totale".
Un premier argument de la classe Ord
donnera le seuil à ne pas dépasser.
La signature de cette fonction sera donc :
fldl :: Ord b => b -> ([b] -> a -> [b]) -> [b] -> [a] -> Maybe b
La fonction fonctionne de la façon suivante:
Si la liste des valeurs est vide, elle retourne Nothing
(Première empreinte).
Si la liste des valeurs contient un seul élément:
Si les distances de la ligne de la matrice D ne dépasse pas le seuil fixé, elle retourne la distance de Levenshtein "totale" (le dernier élément de la liste) via le constructeur Just
.
Si une des distances dépasse le seuil fixé, elle renvoie Nothing
.
Dans tous les autres cas:
Si les distances de la ligne de la matrice D ne dépasse pas le seuil fixé, un appelle récursif de la fonction est effectué avec le reste de la fonction.
Si une des distances dépasse le seuil fixé, elle renvoie Nothing
.
fldl :: Ord b => b -> ([b] -> a -> [b]) -> [b] -> [a] -> Maybe b
fldl t fun a [] = Nothing
fldl t fun a [b] = if lres <= t then Just lres else Nothing
where lres = last $ fun a b
fldl t fun a (b : bs) = if minimum res <= t
then fldl t fun res bs
else Nothing
where res = fun a b
En regardant attentivement la fonction, je remarque qu'elle utilise la fonction minimum
qui permet (comme son nom l'indique très bien) de trouver la valeur minimum dans une liste ne la parcourant entièrement.
Me viens alors une idée d'optimisation. Au lieu de parcourir tout la liste (la ligne de la matrice D), on pourrait se contenter de la parcourir seulement jusqu'à trouver une valeur en dessous du seuil définit. Cela signifierait que la distance de Levenshtein est inférieur au seuil et éviterait d'aller jusqu'en bout de liste.
Je vais donc créer une deuxième fonction levenshteinMaxO
(optimisée) en remplaçant minimum
par la fonction isBellow
Cette fonction isBellow
permet de parcourir une liste et de tester si les éléments sont inférieurs à une certaine valeur seuil.
Dès qu'une valeur de la liste passe en dessous de ce seuil, le parcours de la liste s'arrête et retourne True
.
isBellow [] _ = False
isBellow (x:xs) t
| x < t = True
| otherwise = isBellow xs t
et la fonction principale devient donc
levenshteinMaxO ma "" _ = Nothing
levenshteinMaxO ma _ "" = Nothing
levenshteinMaxO ma str1 str2 = fldl ma transform [0 .. length str1] str2
where
transform ns@(n : ns1) c = scanl calc (n + 1) $ zip3 str1 ns ns1
where
calc z (c1, x, y) =
minimum [y + 1, z + 1, x + fromEnum (c1 /= c)]
fldl t fun a [] = Nothing
fldl t fun a [b] = if lres <= t then Just lres else Nothing
where lres = last $ fun a b
fldl t fun a (b : bs) = if isBellow res t
then fldl t fun res bs
else Nothing
where res = fun a b
Il ne reste plus qu'à tester et comparer ces deux fonctions.
Le fichier source complet peut être trouvé ici
La première chose à faire est de vérifier que nous obtenons les mêmes résultats qu'avec la fonction levenshtein
. Pour cela, on utilisera la librairie quickcheck
qui permet d'effectuer des tests unitaires avec Haskell.
Tout d'abord, nous allons créer de nouveaux types de données qui permettent d'embarquer un couple de chaînes de caractères. Ces types serviront à générer les couples de chaînes à comparer et à tester les différentes fonctions.
Le type Words10
permettra de générer des chaînes d'une longeur de 10 caractères et Words20
de générer des chaînes d'une longueur de 20 caractères.
persoArgs = stdArgs { maxSuccess = 1000, chatty = False }
newtype Words10 = Words10 (String,String)
newtype Words20 = Words20 (String,String)
On crée ensuite pour ces types les instances pour la classe Show
(Pour que ces types puissent être affichés dans les messages d'erreurs lors des tests. Et l'instance de la classe Arbitrary
(Provenant de la librairie Quickcheck
) afin d'associer un générateur de chaînes de caractères pour ce type.
instance Show Words10 where
show (Words10 (a, b)) = show a ++ " / " ++ show b
instance Show Words20 where
show (Words20 (a, b)) = show a ++ " / " ++ show b
instance Arbitrary Words10 where
arbitrary = genWords10
instance Arbitrary Words20 where
arbitrary = genWords20
Nous créons ensuite les générateurs de chaîne de caractère
genWord
permet de générer une chaîne de caractère unique avec une longueur comprise entre deux valeurs min et max
genWord10
permet de générer deux chaînes de caractère de 10 caractères et de la retourner sous la forme d'un type Words10
genWord20
permet de générer deux chaînes de caractère de 20 caractères et de la retourner sous la forme d'un type Words20
genWord lmin lmax = do
l <- choose (lmin, lmax) -- On choisit un entier entre les valeurs min et max
vectorOf l $ (elements "aaaaaaaaaabbbbbbcccdef") -- On génére une liste de valeurs de l éléments issus de la liste
genWords10 = do
a <- genWord 10 10
b <- genWord 10 10
return (Words10 (a, b))
genWords20 = do
a <- genWord 20 20
b <- genWord 20 20
return (Words20 (a, b))
On crée ensuite les propositions de tests. On distinguera deux tests pour chaque fonction levenshteinMax
et levenshteinMaxO
.
Pour une proposition, on calculera les distances avec la fonction à tester et la fonction levenshtein
et on comparera les résultats.
Si la valeur retournée par la fonction levenshtein
est supérieure à la valeur seuil et que la fonction à tester retourne Nothing
, le test réussi
Si la valeur retournée par la fonction levenshtein
est inférieure à la valeur seuil et que la fonction à tester retourne Just
avec une valeur égale à la distance de levenshtein
, le test réussi.
Dans les autres cas, le test échoue.
prop_Words10 n (Words10 (stra, strb)) = prop_Test n stra strb
prop_Words20 n (Words20 (stra, strb)) = prop_Test n stra strb
prop_Words10O n (Words10 (stra, strb)) = prop_TestO n stra strb
prop_Words20O n (Words20 (stra, strb)) = prop_TestO n stra strb
prop_Test n stra strb = if l1 > n then isNothing l2 else l2 == Just l1
where
l1 = levenshtein stra strb
l2 = levenshteinMax n stra strb
prop_TestO n stra strb = if l1 > n then isNothing l2 else l2 == Just l1
where
l1 = levenshtein stra strb
l2 = levenshteinMaxO n stra strb
On crée ensuite les différents alias pour les différents tests avec les différentes tailles de mots et fonctions.
test1 = quickCheckWithResult persoArgs (prop_Words10 3)
test2 = quickCheckWithResult persoArgs (prop_Words20 3)
test3 = quickCheckWithResult persoArgs (prop_Words20 5)
test4 = quickCheckWithResult persoArgs (prop_Words20 8)
test1O = quickCheckWithResult persoArgs (prop_Words10O 3)
test2O = quickCheckWithResult persoArgs (prop_Words20O 3)
test3O = quickCheckWithResult persoArgs (prop_Words20O 5)
test4O = quickCheckWithResult persoArgs (prop_Words20O 8)
On teste ensuite ces fonctions en interactif avec ghci
:
ghci> test1
Success {numTests = 1000, numDiscarded = 0, labels = fromList [([],1000)], classes = fromList [], tables = fromList [], output = "+++ OK, passed 1000 tests.\n"}
ghci> test1O
Success {numTests = 1000, numDiscarded = 0, labels = fromList [([],1000)], classes = fromList [], tables = fromList [], output = "+++ OK, passed 1000 tests.\n"}
ghci> test2
Success {numTests = 1000, numDiscarded = 0, labels = fromList [([],1000)], classes = fromList [], tables = fromList [], output = "+++ OK, passed 1000 tests.\n"}
ghci> test2O
Success {numTests = 1000, numDiscarded = 0, labels = fromList [([],1000)], classes = fromList [], tables = fromList [], output = "+++ OK, passed 1000 tests.\n"}
ghci> test3
Success {numTests = 1000, numDiscarded = 0, labels = fromList [([],1000)], classes = fromList [], tables = fromList [], output = "+++ OK, passed 1000 tests.\n"}
ghci> test3O
Success {numTests = 1000, numDiscarded = 0, labels = fromList [([],1000)], classes = fromList [], tables = fromList [], output = "+++ OK, passed 1000 tests.\n"}
ghci> test4
Success {numTests = 1000, numDiscarded = 0, labels = fromList [([],1000)], classes = fromList [], tables = fromList [], output = "+++ OK, passed 1000 tests.\n"}
ghci> test4O
Success {numTests = 1000, numDiscarded = 0, labels = fromList [([],1000)], classes = fromList [], tables = fromList [], output = "+++ OK, passed 1000 tests.\n"}
Tous les tests réussissent. Et j'estime qu'ils sont suffisamment représentatifs et suffisamment fiables pour utiliser la fonction.
Il ne reste plus qu'à savoir quel est le gain de ces fonctions par rapport à la fonction originale. Pour cela voir, voir le tutoriel Comparatif de performance de fonctions pour calculer la distance de Levenshtein avec un seuil