[Sources] Jeu des chiffres et des lettres

[User]

Titre : Jeu des chiffres et des lettres
Format du fichier: Access 2000 (utilise une barre de progression)
Auteur : User

Intérêt : base de données de plus de 150 000 mots (bd tirés du dico du scrabble disponible sur le net). plus algo de résolution du compte est bon donnant plusieurs solutions détaillées. possibilités d'amélioré ce code...(discussion autour du code).Et biensur tout simplement intérêt ludique


Description:
Ce jeu comprend le mot le plus long et le compte est bon.

Le compte est bon:
Il existe de nombreuses versions de ce jeu sur le net (en Java, Delphi..).
Cette version est facile d'utilisation, notamment pour composer les différentes opérations du compte: les résultats intermédiaires étant automatiquement affichés.

La procédure de recherche des solutions donne plusieurs variantes possibles.

Le mot le plus long:
Ce jeu utilise un dictionnaire de plus de 150 mille mots tirés du dico du Scrabble.
Le tirage des 9 lettres tient compte de la fréquence habituelle d'apparition de chacune des 26 lettres de l'alphabet dans la langue française...

La formation du mot est très simple: il suffit de cliquer sur les lettres en haut du formulaire, puis on valide son résultat par un simple clique.

La procédure de recherche des mots les plus longs renvoie de nombreux résultats classés par longueur de mot (8 lettres, 7 lettres...).

Bon jeu à tous !

Sources au format Access 2000:
Jeu des chiffres et des lettres version n°2
(intègre la méthode de vodiem pour optimiser la recherche des mots les plus longs)

Jeu des chiffres et des lettres version n°3
(intègre l'optimisation de philben directement inspirée de celle de vodiem, plus une méthode récursive (non aléatoire) et optimisée de calcul du compte est bon, toujours par philben)

Jeu des chiffres et des lettres version n°4
(taille de la base fixe: intègre une methode du calcul du compte est bon non recursive: pour celà utilisation d'une librairie en Delphi, et une brève explication)

Après téléchargement, décompresser les 2 fichiers "Chiffres_lettres v4.mdb" et "lib_ceb.dll" dans un même répertoire...

[vodiem]

Salut User,

Vraiment sympa,

je n'ai pas regardé le code pour le compte est bon

mais pour le mot le plus long:
je pense qu'il est possible d'obtenir de meilleur temps de réponse, bien que cela soit suffisamment rapide, en créant un index supplémentaire.
mais peut être au détriment de la lisibilité.

si tu cherches des idées pour une version 2:
> inclure un dictionnaire ou un lien sur un site vers une définition (histoire d'être moins bête et de pouvoir le réutiliser le mot )
> inclure des niveaux: par âge, vocabulaire usuelle/rare... ou thématiques pour orienter le tirage de lettre.
> paramétrages de la base (délai, alternance du jeu, score, changement de dictionnaire langue étrangère...)
> améliorer la charte graphique
> jeu en réseau... lol je plaisante...

non, c'est vraiment sympa: y a des boutons partout et en plus ils marchent.
c'est top.

[User]

Merci à toi !

Je retiens tes idées très interessantes pour une version future...
(c'est vrai que l'on peut entre autre optimiser le code ..)

@+

User

[micniv]

Bravo, User
Je trouve cela top moi aussi
mais aussi que les délais sont un peu trop courts ...pour moi

[random]

bravo !

toutefois si je puis me permettre:


la table dico devrait comporter une clef plus fine

je te propose la méthode suivante

calculer dans le dictionnaire une clef pour chaque mot cette clef sera composée des lettres formant le mot classées dans l'ordre alphabétique
évidemment elle sera indexée

ainsi

on aura
mot clef
CHENI CEHIN
CHIEN CEHIN
CHINE CEHIN
NICHE CEHIN

dès lors si j'ai au tirage hnice il me suffit de calculer la clef (cehin)et j'ai en lecture directe les 4 résultats dans ma table, les calculs du dico étant faits une fois pour toutes

je te joins ci dessous une fonction de calcul de clef

 
Function creclef(x As String) As String
Dim boucl1 As Byte
Dim v1() As Variant
Dim boucl2 As Byte
Dim longu As Byte
Dim tempo As String
longu = Len(x)
ReDim v(1 To longu) As Variant
For boucl1 = 1 To longu
v(boucl1) = Mid(x, boucl1, 1)
Next boucl1
For boucl1 = 1 To longu - 1
    For boucl2 = boucl1 + 1 To longu
        If v(boucl1) > v(boucl2) Then
        tempo = v(boucl1)
        v(boucl1) = v(boucl2)
        v(boucl2) = tempo
        End If
    Next boucl2
Next boucl1
tempo = v(1)
For boucl1 = 2 To longu
tempo = tempo & v(boucl1)
Next boucl1
creclef = tempo
End Function
 

qu'en penses tu ?

[vodiem]

salut User, micniv et random,

j'ai eu le même réflexe que toi random et j'avais donc fait ce code pour obtenir cette même "clef":

Function creerMotif(champ As String) As String
Dim a(25) As Byte
 
For i = 1 To Len(champ)
    c = Asc(Mid(champ, i, 1)) - 65
    a(c) = a(c) + 1
Next i
For i = 0 To 25
    For j = 1 To a(i)
        s = s + Chr(i + 65)
    Next j
Next i
creerMotif = s
End Function

mais cela n'est pas suffisant pour rendre plus rapide le traitement.
jusqu'à présent je suis parvenu à vu d'œil presque 2 fois plus vite, sans lunette et un œil fermé.
j'entrevoie encore une piste qui pourrait améliorer significativement encore ce temps.

[random]

vodiem si je puis me permettre il ne faut pas transposer la clef en numérique (calcul conversion) mais conserver une clef alpha

d'autre part il faut ajouter la clef à dico

reste à traiter tirage et ses descendants

pour cela il suffit de calculer clef(tirage)
si clef(tirage) n'offre pas de solution
si clef(tirage) n'offre pas de solution
itérer
enlever une lettre de clef(tirage)
et réessayer avec les combinaisons ainsi trouvées
le résultat devrait être instantané

[vodiem]

Envoyé par random

vodiem si je puis me permettre il ne faut pas transposer la clef en numérique (calcul conversion) mais conserver une clef alpha

je suis d'accord avec toi: ma fonction renvoie un string.

Envoyé par random

d'autre part il faut ajouter la clef à dico

toujours d'accord avec toi.

Envoyé par random

pour cela il suffit de calculer clef(tirage)
si clef(tirage) n'offre pas de solution
si clef(tirage) n'offre pas de solution
itérer
enlever une lettre de clef(tirage)
et réessayer avec les combinaisons ainsi trouvées
le résultat devrait être instantané

c'est là le truc:
enlever une lettre oui mais laquelle?
il faut donc faire un test sur 2^9=512 combinaisons possibles réduit à nb clef(combinaison(tirage)) distinct.
donc savoir si clef(dico.mot) appartient à clef(combinaison(tirage)) distinct.
et là selon comment on s'y prend le résultat est parfois très loin d'être instantané.

[User]

merci à vous !

Donc j'attends un peu avant d'appliquer votre conseil d'une meilleure clé...

Si je n'ai pas de retour avant ce soir j'incorpore le code de vodiem dans ma base...

encore merci à vous !

[User]

Merci Random et Vodiem pour votre contribution...

Je vais essayer d'appliquer votre méthode mais c'est vrai que c'est pas évident...

@+

[User]

En fait je suis parvenu a environ 1 seconde en changeant un peu le motif et en utilisant un like dans la procedure...

en faisant:

Tirage_classé like motif

ou tirage est par exemple "ABCDEFGHI" et

motif du style "*C*E*F*H*I*" pour "FICHE"

mais la base de données est 2 fois plus grosse

Dernière minute : méthode remplacée par celle de vodiem...

Des chiffres et des lettres version n°2

@+

[vodiem]

Tu m'impressionnes User environ: 1s... c'est pas facile de l'atteindre.

moi, je suis parvenu à avoir presque l'instantané: <1s :p
voilà mon code:

Option Compare Database
Option Base 0
 
Function creerMotif(champ As String) As String
Dim a(25) As Byte
 
For i = 1 To Len(champ)
    c = Asc(Mid(champ, i, 1)) - 65
    a(c) = a(c) + 1
Next i
For i = 0 To 25
    For j = 1 To a(i)
        s = s + Chr(i + 65)
    Next j
Next i
creerMotif = s
End Function
 
Function genCombinaison(chaine As String) As String()
Dim t() As String
Dim i As Long
Dim j As Long
 
n = Len(chaine)
m = 2 ^ n
ReDim t(m - 1)
 
For i = 0 To m - 1
    mx = n - 1    'max pour éviter des décalages inutiles il faudrait: log base 2 +1
    For j = 0 To mx
        s = s + Mid(chaine, j + 1, SHR(i, j) And 1)
    Next j
    t(i) = s
    s = vbNullString
Next i
genCombinaison = t
End Function
 
Function genCombinaison2(chaine As String) As String()  'renvoie un tableau de motif
Dim t() As String
Dim i As Long
Dim j As Long
Dim s As String
 
n = Len(chaine)
m = 2 ^ n
ReDim t(m - 1)
 
For i = 0 To m - 1
    mx = n - 1    'max pour éviter des décalages inutiles il faudrait: log base 2 +1
    For j = 0 To mx
        s = s + Mid(chaine, j + 1, SHR(i, j) And 1)
    Next j
    t(i) = creerMotif(s)
    s = vbNullString
Next i
genCombinaison2 = t
End Function
 
Sub AfficheSolus(Tirage As String)
Dim mt() As String
mt() = genCombinaison2(Tirage)
 
DoCmd.SetWarnings False
DoCmd.RunSQL "delete * from combinaison"
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("combinaison", dbOpenDynaset)
For i = 1 To UBound(mt)
    rs.AddNew
    rs!motif = mt(i - 1)
    rs.Update
Next i
DoCmd.SetWarnings True
rs.Close
 
leSQL = "SELECT t1.mot, len(t1.mot) AS taille " & _
        "FROM dico AS t1 " & _
        "WHERE EXISTS (select t2.motif from combinaison t2 where t2.motif=t1.motif) " & _
        "ORDER BY len(t1.mot) DESC , t1.mot;"
 
Set rs = CurrentDb.OpenRecordset(leSQL, dbOpenSnapshot)
 
While Not rs.EOF
    Debug.Print rs!mot, rs!taille
    rs.MoveNext
Wend
End Sub

.genCombinaison() est là en plus et n'est pas utilisé.
.il faut rajouter une table combinaison avec un champ <motif> indexé
.avoir [dico] avec un motif "normal"
.tu n'as pas de doublement, au plus un "surplus" dû au champ <motif>
.AfficheSolus() ne limite pas le nb de solus, il est possible qu'en adaptant tu puisse encore gagner qq milli seconde...

j'allais oublier SHR(): trouvé ici et réadapté

Function SHR(y As Long, k As Long) As Long ' shr(octet ,nombre de décalage)
SHR = CLng(Int(y / (2 ^ k)))
End Function

je te laisse le soin de l'adapter à ton bébé.

ps: micniv, si ca peut te rassurer: même avec des délais plus long j'ai du mal à trouver de mots de plus de trois lettres. lol

[User]

Impresssionnant !

je l'intègre de ce pas à la version n°2...

Encore merci !

[philben]

bonjour,

mon ami Vodiem a proposé une excellente solution qui mérite seulement une petite optimisation de la requête utilisée.

En effet la clause Where proposée n'est pas optimisable par un index sur la colonne <motif> de la table <dico>.

La requête nommée <RqMots> suivante associée à un index avec doublons sur la colonne <motif> permet d'obtenir pratiquement un affichage instantané d'après mes essais :

 
SELECT DISTINCT D.mot
FROM combinaison AS C INNER JOIN dico AS D ON C.motif=D.motif;
 

Pas besoin d'indexer la colonne <motif> de la table combinaison.

J'en ai profité pour modifier le code de la fonction <generer_resultats> optimisée pour notre cas (tirage de 9 lettres) :

 
Public Function generer_resultats(ByVal Tirage As String)
   Dim oDb As DAO.Database, oRs As DAO.Recordset
   Dim i As Integer, j As Integer
   Dim asLettres(0 To 8) As String, tb_str(2 To 9) As String, s As String
 
   DoCmd.Hourglass True
 
   Set oDb = CurrentDb
   
   'supprime les éventuelles anciennes combinaisons
   oDb.Execute "DELETE FROM Combinaison", dbFailOnError
   Set oRs = oDb.OpenRecordset("Combinaison", dbOpenDynaset)
 
   'Créer un tableau des lettres du tirage
   For i = 0 To 8
      asLettres(i) = Mid$(Tirage, i + 1, 1)
   Next i
   
   'Trier ce tableau par ordre croissant pour respecter le motif de la table dico
   TriLettres asLettres
   
   'Génère 502 motifs (motifs de 1 lettre ne sont pas conservés) par une fonction récursive
   For i = 1 To 8
      GenereMotifs oRs, asLettres, asLettres(i - 1), i
   Next i
 
   'suite du code standard...
   
   Set oRs = oDb.OpenRecordset("RqMots", dbOpenForwardOnly)
   Do Until oRs.EOF
      tb_str(Len(oRs!mot)) = tb_str(Len(oRs!mot)) & oRs!mot & " "
      oRs.MoveNext
   Loop
 
   j = 1
 
   For i = 9 To 2 Step -1
      If tb_str(i) <> vbNullString Then
         s = s & "Mots de " & i & " lettres:" & vbCrLf
         s = s & tb_str(i) & vbCrLf & vbCrLf
         j = j + 1
         If j > 3 Then Exit For
      End If
   Next i
 
   Forms!Mot_plus_long!Solutions = s
 
   Set oRs = Nothing
   Set oDb = Nothing
 
   DoCmd.Hourglass False
 
End Function
 

les deux fonctions secondaires :

 
'Fonction récursive pour générer les motifs
Private Sub GenereMotifs(ByRef oRs As DAO.Recordset, ByRef asLettres() As String, _
                         ByVal sBase As String, ByVal iCurLettre As Integer)
   Dim i As Integer
   For i = iCurLettre To 7
      oRs.AddNew
      oRs!motif = sBase & asLettres(i)
      oRs.Update
      GenereMotifs oRs, asLettres, sBase & asLettres(i), i + 1
   Next i
   oRs.AddNew
   oRs!motif = sBase & asLettres(i)
   oRs.Update
End Sub
 
'Tri croissant d'un tableau de string de 0 à 8 => iInc = 13
Private Sub TriLettres(ByRef asTab() As String)
   Dim i As Integer, j As Integer, iInc As Integer
   Dim sLettre As String * 1
 
   iInc = 13   'car tableau de base 0 et ubound = 8
   While iInc > 1
      iInc = iInc / 3
      For i = iInc To 8
         j = i
         sLettre = asTab(i)
         Do While sLettre < asTab(j - iInc)
            asTab(j) = asTab(j - iInc)
            j = j - iInc
            If j < iInc Then Exit Do
         Loop
         asTab(j) = sLettre
      Next i
   Wend
End Sub
 

Pour réduire la taille de la base, on peut éventuellement enlever la clef primaire sur les mots qui n'est utile, je pense, que si on souhaite ajouter des nouveaux mots.
On peut aussi générer à la volée les index nécessaires au démarrage du programme.

Voilà, à vérifier que tout fonctionne bien , et humbles félicitations à User et Vodiem .

Philippe

[vodiem]

SELECT DISTINCT D.mot
FROM combinaison AS C INNER JOIN dico AS D ON C.motif=D.motif;

nan, j'y crois pas! l'INNER JOIN me "plantait" très souvent et m'avait planté sur ce SQL . je lui ai donc préféré un LEFT JOIN et j'avais donc un piste avec:

SELECT DISTINCT t2.mot, len(t2.mot) AS taille
FROM combinaison AS t1 LEFT JOIN dico AS t2 ON t1.motif = t2.motif
ORDER BY len(t2.mot) DESC , t2.mot;

moins performant qu'avec la clause EXISTS et IN
cela dit après zieutage je ne décèle pas de différence de temps entre la requête que tu as choisi et celle que j'ai choisi.
s'il y a, vous m'excuserez alors d'avoir une mauvaise vue.

les deux fonctions creerMotif et genCombinaison peuvent être surement optimisé comme l'a fait notre Excellence philben.

les temps sont trop court pour ma vue.
il faudrait pouvoir les regarder avec un compteur de temps.

bien que très respectueux de ton travail, je reste perplexe sur le gain de la récursivité du générateur.
je crois que le plus performant serait un tableau de constante prédéfini auquel on appliquerait un ET logique pour obtenir un masquage des lettres et où l'on retirerait/ne mettrait pas les lettres vides.

User tu vas devoir de toute façon faire un comparatif des fonctions avant de les intégrer. pourras tu nous faire connaitre les résultats?
non pas que je remettes en cause les compétences de notre cher philben mais cela lèverait certain de mes aprioris.

une piste que j'avais aussi entrevue et qui évite le champ <motif> et donc une taille de la base plus importante, était d'avoir une fonction qui renverrait oui/non si le motif généré avec le mot faisait parti d'un tableau de combinaison de motif préalablement chargé en mémoire.
on appellerait cette fonction dans une simple requete:

SELECT mot FROM dico WHERE estSolus(mot)

je n'ai pas exploré plus profondément la question.

merci philben pour ta participation et ta sérieuse contribution