Dictionnaires, anagrammes : algos efficaces

Soyez le premier à donner votre avis sur cette source.

Vue 12 359 fois - Téléchargée 740 fois

Description

Salut a tous

Cela fait quelques temps, j'ai remarqué qu'il y avait beaucoup de
sources sur les dictionnaires, générateurs de dictionnaires,
anagrammes ...

Cependant aucune n'implémente la méthodes des arbres pour indexer les
dictionnaires, ou générer des anagrammes. C'est pourtant extremement
rapide et efficace.

Je vais donc essayer de vous présenter cette méthode du mieu possible
afin de vous initier à l'un des fondements (à mon avis ;) ) de
l'algorithmique en programmation : les arbres et quelques
applications.

Source / Exemple :


'*************************************
' Dans un module de classe nommé "Index" :  
'*************************************
Public FinMot As Byte

' 0 -> "-"
' 1..26 -> lettres non accentuées
' 27..38 -> è é ê ë à â î ï ù ô ç û (dans l'ordre)

Private ListeAlpha(0 To 38) As Index

Public Sub AddCar(car As Byte)
    If ListeAlpha(car) Is Nothing Then
        Set ListeAlpha(car) = New Index
    End If
End Sub

Public Function CarExists(car As Byte) As Boolean
    CarExists = Not (ListeAlpha(car) Is Nothing)
End Function

Public Function SousArbre(car As Byte) As Index
    Set SousArbre = ListeAlpha(car)
End Function

Public Sub KillTree()
    Dim i As Byte
    For i = 0 To 38
        Set ListeAlpha(i) = Nothing
    Next
End Sub

' ***********************************
' Dans un module
' ***********************************
Option Explicit

Sub sauvegarderIndex(idx As Index, file As Long, Optional KILL As Boolean, Optional mot As String)
    ' Sauvegarde l 'index dans le fichier spécifié. Attention, ce n'est pas un nom de fichier qui est passé,
    '  mais un identificateur de fichier : c'est le 'n' dans "open filename for output as #n"
    '  KILL indique si l'index doit etre detruit au fur et à mesure qu'on le sauvegarde
    ' Mot ne doit pas etre remplit, ou alors avec la chaine vide ""
    Dim i As Byte, car As String, n As Long
    n = FreeFile
    
    'i=0:cas "-"
    If Not (idx.SousArbre(0) Is Nothing) Then
        car = "-"
        If idx.SousArbre(0).FinMot Then
            Print #file, mot & car
        End If
        sauvegarderIndex idx.SousArbre(0), file, KILL, mot & car
    End If
    
    ' cas lettres non accentuees
    For i = 1 To 26
        If Not (idx.SousArbre(i) Is Nothing) Then
            car = Chr(i + 96)
            If idx.SousArbre(i).FinMot Then
                Print #file, mot & car
            End If
            sauvegarderIndex idx.SousArbre(i), file, KILL, mot & car
        End If
    Next
    
    ' cas lettres accentuees
    For i = 27 To 37
        If Not (idx.SousArbre(i) Is Nothing) Then
            car = Chr(convertFromIndex(i) + 96)
            If idx.SousArbre(i).FinMot Then
                Print #file, mot & car
            End If
            sauvegarderIndex idx.SousArbre(i), file, KILL, mot & car
        End If
    Next
    If KILL Then idx.KillTree
End Sub

Sub chargerIndex(idx As Index, file As String)
    'charge l'index depuis un fichier qui contient 1 mot par ligne
    Dim n As Long, str As String
    n = FreeFile
    Open file For Input As #n
    While Not EOF(n)
        Input #n, str
        ajouterMot str, idx
    Wend
    Close #n
End Sub

Sub lireIndex(idx As Index, Optional mot As String)
    ' lit l'index et, pour  l'exemple, l'affiche dans la fenetre du debuggeur
    Dim i As Byte, car As String
    
    'i=0 : "-"
    If Not (idx.SousArbre(0) Is Nothing) Then
        car = "-"
        If idx.SousArbre(0).FinMot Then
            Debug.Print (mot & car) ' l'expression (mot & car) correspond au mot devant etre affiché...
        End If
        lireIndex idx.SousArbre(0), mot & car
    End If
    
    ' lettres sans accent
    For i = 1 To 26
        If Not (idx.SousArbre(i) Is Nothing) Then
            car = Chr(i + 96)
            If idx.SousArbre(i).FinMot Then
                Debug.Print (mot & car)
            End If
            lireIndex idx.SousArbre(i), mot & car
        End If
    Next
    
    ' lettres accentuees
    For i = 27 To 37
        If Not (idx.SousArbre(i) Is Nothing) Then
            car = Chr(convertFromIndex(i) + 96)
            If idx.SousArbre(i).FinMot Then
                Debug.Print (mot & car)
            End If
            lireIndex idx.SousArbre(i), mot & car
        End If
    Next
    
End Sub

Function estDansIndex(mot As String, idx As Index) As Boolean
    Dim car As Byte, c As Byte
    ' Algorithme de recherche ...
    ' renvoit TRUE si le mot est dans l'index

    If Len(mot) = 0 Then
        estDansIndex = idx.FinMot
    Else
        c = Asc(Left(mot, 1))
                
        If c = 45 Then ' tiret "-"
            car = 0
        Else ' autres lettres
            car = c - 96
        End If
        
        If car > 26 Then ' lettres accentuees
            convertToIndex car
        End If
        
        If idx.CarExists(car) Then
            estDansIndex = estDansIndex(Mid(mot, 2), idx.SousArbre(car))
        Else
            estDansIndex = False
        End If
    End If
End Function

Function ajouterMot(mot As String, idx As Index) As Boolean
    ' Insère un mot dans l'index et renvoi True si l'ajout a bien été effectué,
    '  False sinon (dans le cas ou le mot existait déjà)
    Dim car As Byte, c As Byte
    c = Asc(Left(mot, 1))
    
    
    If c = 45 Then 'le tiret "-"
        car = 0
    Else ' les autres caractères
        car = c - 96
    End If
    
    
    'Suppression des accents : les c aractères ayant une valeur superieur à 26 sont des lettres
    ' accentuées
    If car > 26 Then
        convertToIndex car
    End If
    
    'ajout du mot. fonction récursive
    idx.AddCar car
    If Len(mot) = 1 Then
        If idx.SousArbre(car).FinMot Then
            ajouterMot = False
        Else
            ajouterMot = True
            idx.SousArbre(car).FinMot = True
        End If
    Else
        ajouterMot = ajouterMot((Mid(mot, 2)), idx.SousArbre(car))
    End If
    
    
End Function

Sub effacerIndex(idx As Index)
    ' exemple de fonction qui purge la mémoire de manière "propre"
    ' En fait je ne sais pas si ça nettoie vraiement de supprimer directement
    ' les objets de la racine de l'arbre, sans parcourir les feuilles, vous pouvez toujours essayer ...
    Dim i As Byte
    For i = 1 To 37
        If Not (idx.SousArbre(i) Is Nothing) Then
            effacerIndex idx.SousArbre(i)
        End If
    Next
    idx.KillTree
End Sub

' Les trois fonctions suivantes servent à la reconnaissonce des lettres
Private Function EstLettre(str As String) As Boolean
    EstLettre = (str >= "a" And str <= "z") Or (str >= "A" And str <= "Z") Or _
                str = "é" Or str = "è" Or str = "ï" Or "û" Or str = "ù" Or str = "î" Or str = "ë" Or _
                str = "à" Or str = "ê" Or str = "ç" Or str = "â" Or str = "ô" Or str = "-"
End Function

Sub convertToIndex(car As Byte)
    Select Case car
        Case 136 To 139
            car = car - 109   'é, è, ê, ë
        Case 128
            car = 31 'à
        Case 130
            car = 32 'â
        Case 142 To 143
            car = car - 109 ' ï î
        Case 153
            car = 35 ' ù
        Case 148
            car = 36 ' ô
        Case 135
            car = 37 ' ç
        Case 155
            car = 38
        Case Else
            MsgBox car
    End Select
End Sub

Function convertFromIndex(i As Byte) As Byte
    Select Case i
        Case 27 To 30, 33, 34
            convertFromIndex = i + 109
        Case 31
            convertFromIndex = 128
        Case 32
            convertFromIndex = 130
        Case 35
            convertFromIndex = 153
        Case 36
            convertFromIndex = 148
        Case 37
            convertFromIndex = 135
        Case 38
            convertFromIndex = 155
    End Select
End Function

Conclusion :


Tout d'abord, donnons nous un premier but :

Supposons que l'on ai un dictionnaire sous la main, sous forme de
fichier texte, contenant TOUS les mots de la langue française.
Il contient plus de 350 000 mots !!!(et pèse environ 3.8 Mo non
compressé et environ 800ko compressé).

On supposera aussi que l'on a de quoi a travailler sur environ 200 Mo
en memoire centrale (ce sera certainement utopique pour certains ...)
et que le dico que l'on a est en un seul bloc.

On souhaite réaliser une application qui va utiliser ce dictionnaire
(du style de MOTUS, DES CHIFFRES ET DES LETTRES - pour les lettres,
évidemment ! -, LE PENDU ...)

Il faut donc rendre ce projet viable en terme de temps de reponse.

Donc ce qu'il faut c'est utiliser une structure optimisée pour la
recherche dans le dico. S'offrent à nous au moins 3 solutions (ce sont
les trois principales qui me viennent a l'esprit) :

- Une recherche "brute" dans le dico :
1/ on parcours tous les mots, un à un, jusqu'àce que l'on trouve
celui qui nous interesse ...
problemes : bien que ce soit très simple à mettre en oeuvre,
c'est très long !!!

2/ on effectue une recherche dichotomique... IL FAUT QUE LE DICO
SOIT TRIE !!! sinon, pas de recherche dichotomique !
C'est rapide : sur un dico de 350 000 mots, il faut en moyenne
18 comparaisons (log(350 000) / log(2)).
Mais y a un blème : les temps d'accès et l'ajout de mots dans
le dictionnaire.
-> acceder directement au fichier nous evitera d'avoir
a charger le dico, mais le temps d'acces sera élevé
-> créer une structure (un tableau de preference) va
prendre peu de memoire :
Souvenez vous: 3.8 Mo le fichier (environ 4 000 000
octets) pour 350 000 mots, soit ONZE lettres environ par mot
DONC en memoire : 24 octets (pour le tableau -
merci VB ;) ) + ( 10 octets(fixes) + 11 octets par mot dans
le tableau) * 350 000 = 7 350 024 octets
Ce qui est somme toute raisonnable !
-> là où ça se complique c'est lorsque l'on veut fair
évoluer le dictionnaire, c'est pas évident d'insérer de
nouveaux mots au bon endroit, lorsqu'on travaille avec un gros
tableau, il faut faire du tri. Et la ça peut être long, voir
très long ! En plus le code devient très vite complexe (dans
le sens où il n'est pas evident a débroussailler), comparé à
la solution que je vais vous proposer.

3/ LA solution qui est le thème de ce tutorial : charger le dico
dans un arbre.
"Mais kêkeucé ?" , certains vont me dire.
Pour ce qui ne savent pas ce qu'est un arbre (en info ;) ):
C'est une structure de donnée qui possède, dans notre
cas, 2 éléments différents : des noeuds et des branches. Et
accessoirement des feuilles, qui sont en fait des noeuds sans
descendants (et sans branches). Un exemple de représentation
d'arbre : l'arbre généalogique. Dans un arbre généalogique, un
noeud est considéré comme une feuille dés lors qu'il n'a pas
de descendant.

Voila pour la brève description.

Attaquons nous maintenant à la description du dico.
En fait, chaque noeud de l'arbre correspondra à l'une des 26
lettres de l'alphabet. Les fils de chaque noeud seront donc
d'autres lettres de l'alphabet.
Par exemple on souhaite rentrer le mot "jeu" dans le
dictionnaire.
Le premier niveau contiendra la lettre "j", le fils (pour
l'instant unique) contiendra la lettre "e" (niv. 2) et le fils de ce
dernier la lettre "u" (niv. 3).
Jusque là pas de problème.
Maintenant on souhaite rajouter le mot "jour".
Rappelez-vous, notre dico ne contient que le mot "jeu". a la
racine on a la lettre "j". Donc pour rajouter "jour", on a pas
besoin de repeter la lettre "j" (niv. 1). Par contre on va creer un
autre fils de cette lettre : la lettre "o" (niv. 2), puis "u"
(niv. 3), puis "r" (niv. 4).
Mais attention ! la lettre "u" au niveau 3 n'est pas la même
pour le mot "jeu" et pour le mot "jour". Pour l'un c'est la
descendante du "e" et pour l'autre c'est la descendante du
"o".
Supposons maintenant qu'on veuille rajouter le mot "jeudi".
Facile !
"j" (n.1) existe déjà,"e" (n.2) aussi, "u" (n.3) aussi, et y a
plus qu'à rajouter "d" et "i" aux niveaux 4 et 5. Mais là se
pose un problème : comment savoir où s'arrète le mot au moment
de la relecture ? Il faut donc créer un indicateur permettant
de savoir si l'on a atteint la fin d'un mot ou non.
Donc pour resumer, chaque noeud contiendra 2 infos : la lettre
et un indicateur pour savoir si l'on est en fin de mot.

Ca y est, notre structure est prète. Il va maintenant falloir
la représenter en VB.
Si vous l'avez remarqué, c'est une structure récursive, donc
pas moyen de la représenter avec qqchose du style "type Dico
... End Type". Il faut utiliser une classe.

Soit la classe Index qui representera notre dico. Voici sa
descritpion :

Public FinMot As Byte

Private ListeAlpha(1 To 26) As Index

Public Sub AddCar(car As Byte)
If ListeAlpha(car) Is Nothing Then
Set ListeAlpha(car) = New Index
End If
End Sub

Public Function CarExists(car As Byte) As Boolean
CarExists = Not (ListeAlpha(car) Is Nothing)
End Function

Public Function SousArbre(car As Byte) As Index
Set SousArbre = ListeAlpha(car)
End Function

Public Sub KillTree()
Dim i As Byte
For i = 1 To 26
Set ListeAlpha(i) = Nothing
Next
End Sub

FinMot est notre indicateur de fin de mot (FinMot = 1 -> fin
du mot), et ListeAlpha est
un tableau de 26 'Index' (appel recursif de la classe), un
pour chaque caractere. On pourrait rajouter une propriété
supplémentaire pour stocker le nom du caractère du noeud, mais
lors de l'implémentations des différents algorithmes de
recherche, d'insertion, et de sauvegardes, l'on s'aperçoit que
c'est inutile, et vous verrez que cela nous permet de gagner
quelques (nombreux) precieux octets.
Vous aurez remarqué que le tableau est Private car il est
impossible en VB qu'un membre PUBLIC d'une classe soit un
tableau.
Donc il faut créer des procédures d'ajouts, et de tests pour
manipuler l'arbre, qui sont heureusement peu nombreuse.
AddCar rajoute le caractère dans l'arbre s'il n'existe pas
déjà.
CarExists renvoi vrai si le caractère existe, càd si l'objet
ListeAlpha(car) fait bien reference à un index (et est donc
différent de NULL - Nothing en VB-).
SousArbre retourne le sous-arbre correspondant au caractère
'car', c'est ce qui permet de parcourir l'arbre, c'est une
fonction vitale !
Enfin une dernière procédure, KillTree qui s'occupe en fait de
décharger l'arbre de la mémoire.

Revenons maintenant à nos stats. Ici, il est vrai, l'on a
besoin de beacoup de mémoire, car contrairement à la méthode
précédente, on ne travaille pas sur des chaines de caractères,
mais sur les caractères eux-même et lon ajoute beaucoup
d'infos supplémentaires pour chaque caractères.

En gros une instance Index requiert

FinMot = 1 octet
+
ListeAlpha = 24 + 26 octets * 4 = 128 octets

soit = 129 octets par Objet Index.

Explication du calcul :
En VB, quelque soit le tableau, il necessite 20 octets + 4
octets par dimensions (d'où le '24') + les données du tableau.
Dans notre cas, c'est un tableau d'objet, ou plutot de
references d'objet ( equivalent à une adresse mémoire, pour
ceux qui ont déjà fait du C): donc 4 octet * 26 cases.

Par exemple, si l'on avait 3 800 000 caractères, cela ferait :
3 800 000 * 129 = 490 200 000 octets (467,5 Mo) !!!

Heureusement, notre structure est optimisée et des lettres sont
créées qu'une fois alors qu'utilisées dans plusieurs mots,
cela n'empèche que le dico, en l'etat prendrait environ 150 Mo,
c'est à peu pres ce que j'ai constaté dans la pratique.

C'est beaucoup, mais les recherches en sont simplifiées :
aucune comparaison n'est nécessaire : par exemple, on
recherche un mot composé de n lettres, lorsqu'on est à l'étage
i (1<=i<=n), si la lettre existe alors on passe à l'étage
suivant et sinon cela signifie que le mot n'existe
pas. Lorsqu'on a testé toutes les lettres du mot, si
l'indicateur du niveau où l'on se trouve est à 1 alors le mot
recherché existe, sinon il n'existe pas. C'est tout ! Et
croyez moi c'est très rapide, car un mot, on l'a vu
précédemment, a 11 lettres en myenne. Et en plus ce sont des
comparaisons très simple, entre valeurs de type 'byte',
contrairement à la solution précédente qui comparait des
chaines de caractères.

De même, vous verrez dans la source que pour trier, il n'y a
rien à faire, l'insertion que l'on pratique trie implicitement
notre index.

Bon maintenant, revenons-en au code. la classe donnée
précédemment ne traite que 26 caractères, c'est à dire les
lettres non-accentuées, c'est pourquoi il faut donc la
modifier légèrement pour qu'elle ne traite plus 26 mais 38
caractères (c'est à peu près ce qu'il faut pour les lettres
accentuées et le tiret "-"). Malheureusement ça va augmenter
considérablement la place en mémoire ( je suis arrivé à près
de 200Mo !!). Mais bon après chacun fait en fonction de ses
besoins. De plus, moi j'ai divisé le dictionnaire en 26 et au
plus ça prend 50 ou 60 Mo en mémoire, ce qui est davantage
acceptable (pour moi du moins).

Enfin du code vallent mieu que des paroles, (quoique pas
toujours ;)) je joint 2 sources, l'une qui permet de gérer le
dico et l'autre qui génère des anagrammes grace aux
arbres. Comme ça vous allez pouvoir vous amuser à faire un jeu
du style 'Des Chiffres et Des Lettres' si le courage vous en
dit !

J'espère que ça vous aura aidé, pour toutes questions,
eclaircissements, n'hésitez pas !

---------------------------

PS dans la zone de code il y a ce qu'il faut pour gerer le dico, en dans le zip un generateur d'anagrammes

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_Agaga
Messages postés
36
Date d'inscription
mercredi 11 avril 2001
Statut
Membre
Dernière intervention
14 septembre 2006
-
AU fait, j'ai oublié de vous donner les adresses des dictionnaires !

Le dico séparé par lettre :
http://theagaga.free.fr/dicos.zip (~800 ko)

Le dico complet :
http://theagaga.free.fr/dico.zip (~800 ko)
cs_Jack
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61 -
et 90.000 mots et verbes ici
http://www.vbfrance.com/code.aspx?id=28995
JoePatent
Messages postés
171
Date d'inscription
jeudi 30 janvier 2003
Statut
Membre
Dernière intervention
20 juillet 2008
-
Juste une remarque mineur

Ce genre de fonction :
Private Function EstLettre(str As String) As Boolean
EstLettre = (str >= "a" And str <= "z") Or (str >= "A" And str <= "Z") Or _
str "é" Or str "è" Or str = "ï" Or "û" Or str = "ù" Or str = "î" Or str = "ë" Or _
str "à" Or str "ê" Or str = "ç" Or str = "â" Or str = "ô" Or str = "-"
End Function

Devrait se faire en convertissant la string dès le départ afin de s'economiser une bursite en tapant tous les codes.

Private Function EstLettre(str As String) As Boolean
str=lcase$(str)
EstLettre = (str >= "a" And str <= "z") Or _
str "é" Or str "è" Or str = "ï" Or "û" Or str = "ù" Or str = "î" Or str = "ë" Or _
str "à" Or str "ê" Or str = "ç" Or str = "â" Or str = "ô" Or str = "-"
End Function

Autrement il te manque tous les caractères accentués et majuscules...
cs_Agaga
Messages postés
36
Date d'inscription
mercredi 11 avril 2001
Statut
Membre
Dernière intervention
14 septembre 2006
-
Salut Joe
Euh, en fait c'est volontaire qu'il manque toutes les lettres majuscules, car le dico que j'utlisais ne contenait que des minuscules. Par contre c'est vrai que je fais inutilement le test des majuscules.

Merci pour la remarque
A+
cs_drissou
Messages postés
160
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
14 janvier 2009
-
Bonjour,

sur ta fonction EstLettre() pourquoi ne pas mettre toutes tes lettres dans une chaine et tester avec Instr ?

Drissou

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.