Mots croisés
Introduction
Cette page contient quelques outils pour les mots croisés. Ils ont été écrits dans le but de participer à un concours de mots croisés. Ces outils existent déjà mais il est difficile de les obtenir en version libre.
Sur le site Le Grand Défi des mots croisés, il y a une base de mots intéressante -OGD des noms communs- qui comporte 489 166 mots. Elle est disponible ici.
Le premier code trie les mots dans des fichiers texte en fonction de leurs longueurs.
Const ForReading=1
const ForWriting=2
Const source="***.txt"
Set fso=CreateObject("Scripting.FileSystemObject")
maxLettre=0
Set f1=fso.OpenTextFile(source,ForReading)
Do While f1.AtEndOfStream<>True
word=Trim(f1.ReadLine)
If Len(word)>maxLettre Then
maxLettre=Len(word)
End If
Loop
f1.Close
MsgBox("Nombre maximal de lettres:" & maxLettre)
For nombreLettres=1 To maxLettre
destination="LISTE\mots." & nombreLettres & ".txt"
Set f2=fso.CreateTextFile(destination,True)
Set f1=fso.OpenTextFile(source,ForReading)
Do While f1.AtEndOfStream<>True
word=Trim(f1.ReadLine)
If Len(word)=nombreLettres Then
f2.WriteLine(word)
End If
Loop
f1.Close
f2.Close
Next
MsgBox("Fin")
WScript.Quit
Tri des mots par points
Dans le concours, un mot-clé donne les lettres autorisés et permet d'assigner un nombre de points pour chaque lettre. Dans l'exemple ci-dessous, le mot COMPTABLE est retenue avec différentes pondérations. Nous utilisons un objet VBS "Dictionary" pour pouvoir manipuler un tableau associatif. Seuls les mots composés des lettres permises sont retenus et le nombre de points correspondant est calculé. Le fichier de sortie est de type CSV pour pouvoir le lire avec Microsoft Excel.
Const ForReading=1
const ForWriting=2
Const maxLettre=26
Set fso=CreateObject("Scripting.FileSystemObject")
Set point=CreateObject("Scripting.Dictionary")
'Valuation des lettres
point.Add "A",4
point.Add "B",6
point.Add "C",1
point.Add "D",0
point.Add "E",4
point.Add "F",0
point.Add "G",0
point.Add "H",0
point.Add "I",0
point.Add "J",0
point.Add "K",0
point.Add "L",5
point.Add "M",5
point.Add "N",0
point.Add "O",6
point.Add "P",3
point.Add "Q",0
point.Add "R",0
point.Add "S",0
point.Add "T",2
point.Add "U",0
point.Add "V",0
point.Add "W",0
point.Add "X",0
point.Add "Y",0
point.Add "Z",0
message="Regle: "
lettre=point.Keys
valeur=point.Items
For i=0 To UBound(lettre)
If valeur(i)<>0 Then
message=message & lettre(i) & "=" & valeur(i) & " "
End If
Next
WScript.Echo message
For nombreLettres=1 To maxLettre
source="LISTE\mots." & nombreLettres & ".txt"
destination="RESULTAT\mots." & nombreLettres & ".csv"
Set f1=fso.OpenTextFile(source,ForReading)
Set f2=fso.CreateTextFile(destination,True)
Do While f1.AtEndOfStream<>True
word=f1.ReadLine
points=0
interdit=False
For i=0 To UBound(lettre)
points=points+UBound(Split(word,lettre(i),-1,1))*valeur(i)
interdit=interdit Or (UBound(Split(word,lettre(i),-1,1))>0 And valeur(i)=0)
Next
If Not(interdit) Then
f2.WriteLine(word & ";" & points)
End If
Loop
f2.Close
f1.Close
Next
MsgBox("fin")
WScript.Quit