Ce tutoriel est la conséquence de cette discussion. J'en profite pour remercier tous les participants et, tout particulièrement, les trois protagonistes que sont Carlvb, ucfoutu et Whismeril.
Pour comprendre ce tutoriel, inutile d'être un expert en VBA. Cependant, certaines notions doivent être assimilées au préalable. Notamment, les variables tableaux, les Objets Range & Dictionary, les bases des classes en VBA sont des notions qui se doivent d'être connues.
Présentation
Ce jeu est une adaptation, au logiciel de bureautique Excel via VBA, du célèbre jeu de lettres « Boggle » conçu par Alan Turoff et déposé par Parker Brothers / Hasbro.
Pour en saisir le fonctionnement, il nous faut tout d'abord en définir les règles du jeu (Extrait de l'article Wikipédia).
Règles
Le jeu commence par le mélange d'un plateau (carré) de 16 dés à 6 faces, généralement en le secouant. Chaque dé possède une lettre différente sur chacune de ses faces. Les dés sont rangés sur le plateau 4 par 4, et seule leur face supérieure est visible. Le joueur cherche, en 3 minutes, le plus possible de mots pouvant être formés à partir de lettres adjacentes du plateau. Par « adjacentes », il est sous-entendu horizontalement, verticalement, ou en diagonale. Le « chemin » parcouru pour former un mot peut être un mélange de ces trois directions, le sens emprunté au départ n'est pas nécessairement conservé. Les mots doivent être de 3 lettres au minimum, peuvent être au singulier ou au pluriel, conjugués ou non, mais ne doivent pas utiliser plusieurs fois le même dé pour un même mot.
Attribution des points
Les points sont attribués suivant la taille des mots trouvés. Les mots de 3 et 4 lettres comptabilisent 1 point, ceux de 5 lettres 2 points, 6 lettres 3 points, 7 lettres 5 points et 8 lettres (et plus) 11 points.
Le tirage aléatoire des 16 dés
Description
Les lettres composant les 6 faces de ces 16 dés sont fixées :
"ETUKNO", "EVGTIN", "DECAMP", "IELRUW", "EHIFSE", "RECALS", "ENTODS", "OFXRIA", "NAVEDZ", "EOIATA", "GLENYU", "BMAQJO", "TLIBRA", "SPULTE", "AIMSOR", "ENHRIS".
Le tirage de ces dés doit être aléatoire, c'est-à-dire que chaque dé doit retomber, sur une face aléatoire ET dans une case de notre grille de manière aléatoire également. Pour cela, nous allons avant tout fixer notre grille ainsi que les différentes possibilités de lettres pour les dés.
Nous voulons mélanger les dés afin qu'ils ne tombent pas systématiquement sur la même case (cellule) de notre grille (Range). Placer les dés équivaut, dans notre code, à les mélanger dans leur numérotation. Nous allons donc mélanger les valeurs de l'Array cubes :
Private Sub touille_cubes(ByRef cubes)
Dim i As Integer, nb As Integer, ou As Integer, temp As String
nb = UBound(cubes)
'le mélange se fait 2 par 2, donc la boucle se fait sur la moitié
For i = 0 To nb / 2
'ou = variable déterminant l'indice auquel est situé le dé dans l'array cubes
ou = Int(((15 - i) * Rnd))
'variable de stockage temporaire
temp = cubes(ou)
'on « déplace » les deux dés = mélanger l'array cubes
cubes(ou) = cubes(nb - i)
cubes(nb - i) = temp
Next
End Sub
Variante
Il ne s'agit que d'une variante de la procédure précédente.
For i = 1 To 16
j = 1 + Int(16 * Rnd())
While Cubes_Touilles(j) <> ""
j = 1 + Int(16 * Rnd())
Wend
Cubes_Touilles(j) = Cubes(i)
Next i
Tirage au sort des lettres
Une fois cette répartition des cubes réalisée, ne reste plus qu'à tirer, par dé, une lettre aléatoirement en fonction de sa position et la placer dans une cellule de notre Range Grille :
Randomize Timer
For Each Cel In Grille
carac = CInt((5 * Rnd()) + 1)
Cel.Value = Mid(cubes(cpt), carac, 1)
cpt = cpt + 1
Next Cel
Code complet
Les deux procédures vues précédemment, avec les déclarations de variable nous donnent les codes suivants :
Sub Tirage()
Dim cubes As Variant
Dim cpt As Byte, carac As Integer
Dim Grille As Range, Cel As Range
Set Grille = Worksheets("Tirage").Range("A1:D4")
cubes = Array("ETUKNO", "EVGTIN", "IELRUW", "DECAMP", "EHIFSE", "RECALS", _
"ENTDOS", "OFXRIA", "NAVEDZ", "EIOATA", "GLENYU", "BMAQJO", "TLIBRA", _
"SPULTE", "AIMSOR", "ENHRIS")
Randomize Timer
touille_cubes cubes
For Each Cel In Grille
carac = CInt((5 * Rnd()) + 1)
Cel.Value = Mid(cubes(cpt), carac, 1)
cpt = cpt + 1
Next Cel
End Sub
Private Sub touille_cubes(ByRef cubes)
Dim i As Integer, nb As Integer, ou As Integer, temp As String
nb = UBound(cubes)
For i = 0 To nb / 2
ou = Int(((15 - i) * Rnd))
temp = cubes(ou)
cubes(ou) = cubes(nb - i)
cubes(nb - i) = temp
Next
End Sub
Le dictionnaire
Comme pour tout jeu de lettres, cet élément est indispensable au bon déroulement du jeu. Nous avons donc besoin d'un dictionnaire le plus complet possible, comprenant les conjugaisons des verbes, les pluriels et singuliers des mots de 3 à 16 lettres.
Nous souhaitons obtenir un fichier texte composé d'un mot par ligne. Il existe plusieurs solutions pour la création de ce dictionnaire. Nous allons en détailler ici deux : à partir d'un fichier texte existant et à partir d'un site Internet.
Pour charger en mémoire un dictionnaire, nous avons deux possibilités. Soit nous chargeons un dictionnaire brut (texte avec un mot par ligne), soit nous chargeons un dictionnaire compilé avec une structure d'arbre.
Pour charger un dictionnaire brut en mémoire, il nous suffit de reprendre la méthode utilisée dans le chapitre précédent pour construire un dictionnaire compilé, en y enlevant la partie d'écriture du fichier texte.
Pour charger un dictionnaire compilé en structure d'arbre, il suffit de suivre les indications du dictionnaire compilé. A savoir :
- "[" indique qu'on descend d'un niveau pour parcourir un noeud fils,
- "(" indique qu'on passe au noeud suivant le noeud actuel,
- "]" indique qu'on remonte d'un niveau vers le noeud parent,
- "." indique la fin d'un chemin, et donc d'un mot.
Ce qui nous donne le code suivant :
MonDico = "C:\dicos compiles\MonDico.txt" 'A ADAPTER BIEN SUR
Open MonDico For Input As #FF
Line Input #1, Lettre
'Vérification de l'entête du fichier et récupération du nombre de mots dans le dictionnaire compilé
If Left(Lettre, 6) <> "NBMOTS" Then
MsgBox "Le fichier sélectionné n'est pas un dictionnaire compilé", vbCritical
Close #FF
Exit Sub
End If
Set Noeud_Actuel = Debut
While Not EOF(FF)
Line Input #1, Lettre
'On construit l'arbre à partir des indications dans le dictionnaire compilé
If Lettre = "[" Then
Line Input #1, Lettre
Set Noeud_Actuel = Ajouter_Fils(Noeud_Actuel, Lettre)
End If
If Lettre = "(" Then
Line Input #1, Lettre
Set Noeud_Actuel = Ajouter_Suivant(Noeud_Actuel, Lettre)
End If
If Lettre = "]" Then
Set Noeud_Actuel = Noeud_Actuel.Parent
End If
Wend
Close #FF
La recherche des solutions
Il existe plusieurs possibilités pour trouver toutes les solutions, contenues dans le dictionnaire, à partir des lettres de notre grille. Nous avons retenu pour ce projet la solution la plus rapide, à savoir la recherche dans un dictionnaire structuré en arbre. Nous aurions également pu choisir une recherche récursive des mots à partir d'une liste restreinte de notre dictionnaire.
La recherche récursive
La question, à cette étape, se pose : Qu'elle méthode utiliser pour la recherche des solutions ? Il est évident qu'une procédure récursive exige, au préalable, la réduction du dictionnaire. Nous ne pouvons effectivement pas réaliser une boucle sur chacune des lettres de plus de 300000 mots. Il s'avère que malgré une réduction drastique de ce dernier, la recherche dure encore beaucoup trop longtemps pour être réellement fonctionnelle dans un jeu.
Pour information, lors du développement, nous avons abandonné cette piste avec des résultats entre 7 et 30 secondes selon les différentes grilles testées. Ces temps nous ont alors poussé vers la solution de recherche dans une structure d'arbre, solution proposée par Carlvb.
La recherche « dans l'arbre »
Pour effectuer cette recherche, nous allons avoir besoin d'un module de classe Classe_Solutions et de plusieurs fonctions.
Le Module de classe
Tout comme la Classe_Noeud (Cf tutoriel : Compilation d'un dictionnaire en structure d'arbre), le code en est très simple, et se réduit à deux déclarations de variables constituant un « Objet ».
'Cette classe représentent un noeud dans la liste des solutions triées par ordre alphabétique
Public Valeur As String
Public Fils As Classe_Solution
Les fonctions
La fonction principale
Cette procédure recherche les mots dans le dictionnaire qu'on peut former à partir de la grille tout en respectant les règles.
Sub Lister_Solution()
Dim pris() As Boolean
Dim i As Integer, j As Integer, c As Integer
'Initialisation de la chaine des solutions
Set Solution = New Classe_Solution
Solution.Valeur = "AAA"
'On recherche les mots commençant par les 16 lettres du tirage successivement
Dim z As Boolean
For i = 1 To 4
For j = 1 To 4
ReDim pris(1 To 4, 1 To 4)
pris(i, j) = True
z = trouve(Debut, TIRAGE(i, j))
Lister TIRAGE(i, j), i, j, pris
Next j
Next i
End Sub
La recherche proprement dite
Sub Lister(Racine As String, ByVal Ligne As Integer, ByVal Colonne As Integer, Grille() As Boolean)
Dim X As Integer, Y As Integer
Dim Nouvelle_Racine As String
Dim Nouvelle_Grille(1 To 4, 1 To 4) As Boolean
Copier_Grille Grille, Nouvelle_Grille
'Une grille de 4x4 est utilisée pour noter les lettres déjà utilisées afin de ne pas pouvoir les réutiliser
'On parcourt de manière récursive les cases adjaçantes à une case pour rechercher les mots
For X = Ligne - 1 To Ligne + 1
For Y = Colonne - 1 To Colonne + 1
If X >= 1 Then
If X <= 4 Then
If Y >= 1 Then
If Y <= 4 Then
'On n'utilise la lettre dans une case qu'une seule fois
If Not Nouvelle_Grille(X, Y) Then
'Si un chemin peut mener à un mot du dictionnaire, on le suit
If trouve(Noeud_Actuel, TIRAGE(X, Y)) Then
Nouvelle_Racine = Racine & TIRAGE(X, Y)
Nouvelle_Grille(X, Y) = True
'Si le chemin aboutit à un noeud final c'est qu'il s'agit d'un mot valide
'Si le mot ainsi trouvé a une taille d'au moins trois lettres, on l'insère dans la chaîne des solutions
If trouve(Noeud_Actuel, ".") Then
If Len(Nouvelle_Racine) >= 3 Then
Ajouter_Solution Nouvelle_Racine
End If
Set Noeud_Actuel = Noeud_Actuel.Parent
End If
Lister Nouvelle_Racine, X, Y, Nouvelle_Grille
Set Noeud_Actuel = Noeud_Actuel.Parent
Nouvelle_Grille(X, Y) = False
End If
End If
End If
End If
End If
End If
Next Y
Next X
End Sub
Les fonctions d'ajout des solutions
La liste des solutions est stockée sous forme de chaine dont les maillons représentent une solution trouvée. Le tri et la suppression des doublons se font par insertion :
On parcourt la chaine pour repérer l'endroit où la nouvelle solution doit être insérée et si une occurrence de cette solution est déjà dans la chaîne on ne l'y insère plus.
Sub Ajouter_Solution(Nouvelle_Solution As String)
Dim Ancien_Fils As Classe_Solution, Nouveau_Fils As Classe_Solution
Set Maillon = Solution
While Not Maillon.Fils Is Nothing
If Maillon.Fils.Valeur = Nouvelle_Solution Then Exit Sub
If Maillon.Fils.Valeur > Nouvelle_Solution Then
Set Ancien_Fils = Maillon.Fils
Set Nouveau_Fils = Inserer(Maillon, Nouvelle_Solution)
Set Nouveau_Fils.Fils = Ancien_Fils
Exit Sub
End If
Set Maillon = Maillon.Fils
Wend
Set Maillon = Inserer(Maillon, Nouvelle_Solution)
Set Ancien_Fils = Nothing
Set Nouveau_Fils = Nothing
End Sub
Public Function Inserer(ByVal Noeud As Classe_Solution, Mot As String) As Classe_Solution
'Cette fonction rajoute une nouvelle solution à la fin de la chaine des solutions
Set Inserer = New Classe_Solution
Inserer.Valeur = Mot
Set Noeud.Fils = Inserer
End Function
Fonction secondaire
Cette procédure copie le contenu d'un tableau vers un autre
Sub Copier_Grille(source() As Boolean, Destination() As Boolean)
Dim i As Integer, j As Integer
For i = 1 To 4
For j = 1 To 4
Destination(i, j) = source(i, j)
Next j
Next i
End Sub
Le jeu complet est disponible au format .zip (3,69 Mo) ici : http://cjoint.com/?DHflX2rRnOQ Vous y retrouverez les codes décrits ici ainsi que pas mal d'autres petites subtilités.
Le jeu se déroule depuis un UserForm. Pour revenir sur les feuilles du classeur et ainsi pouvoir accéder au code, vous pouvez aller dans l'Userform Menu, bouton "Crédits" => bouton "retour"
N'hésitez pas à me signaler tous bugs et/ou dysfonctionnements éventuellement rencontrés...
Merci à vous.
Cet article est régulièrement mis à jour par des experts sous la direction de Jean-François Pillou, fondateur de CommentCaMarche et directeur délégué au développement numérique du groupe Figaro.
