[VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Staple1600

XLDnaute Barbatruc
Bonjour à tous

Je cherche à réaliser sous VBA la chose suivante:

Lister les solutions possibles de ce jeu:
Ce lien n'existe plus
C'est à dire : avec les opérateurs de base +,-,*,/,(,) : trouver 24 avec 4 chiffres de( 1à 9 ) tiré au hasard

Un petit cadeau pour ceux qui sauront m'aider :)
(car malheureusement les maths et moi on a pas trop d'accointances ;) )
[flash]http://www.novelgames.com/flashgames/game.swf?id=73[/flash]
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Re,

Pour ton bug, peut-être que le problème vient du fait que la fonction mini de pierrejean renvoie du texte.

Or tu écris :

cl = DecToHex(mini(x1, x2, x3, x4))

qui envoie donc du texte à la fonction DecToHex

Dans la fonction, on a :

Public Function DecToHex(DecVal As Double) As String

Double et String ne s'accordent peut-être pas...

Essaie en ajoutant à la fin de la fonction mini :

mini = 1 * mini

Bonne fin de soirée.
 

job75

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Re,

Et puis tout simplement Staple :

- la fonction DecToHex est déclarée As String

- cl est déclaré As Integer (ou As Double, je ne sais plus).

A+
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Re


Merci job75 grâce à toi j'ai réussi ce petit aparté hexadécimal qui finalement n'apporte rien , le temps d'exécution étant le même.

Je ne vois toujours pas comment faire correspondre la formule et la combinaison avec les collection pour afficher la bonne solution.


Bonne nuit à toi et encore merci de ton implication dans ce post.
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Re

Finalement tout à coup j'ai eu une idée toute simple

(C'est là qu'on voit que je suis plus tout jeune lol )
Code:
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public formule As New Collection
Public combinaison As New Collection
[COLOR=Blue][B]Public solution As New Collection[/B][/COLOR]

Sub Opérateurs_Staple()
Dim lngStart As Long
Dim lngFinish As Long
Dim temps As Long
Dim Hours As Double
Dim Minutes As Double, Seconds As Double
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
Dim f1, f2, f3, f4, f5 As String, cl As Double
lngStart = GetTickCount()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("A:A").ClearContents
op = Array("+", "-", "*", "/")
For x1 = 1 To 9
For x2 = 1 To 9
For x3 = 1 To 9
For x4 = 1 To 9
For o1 = 0 To 3
For o2 = 0 To 3
For o3 = 0 To 3

f1 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & x3 & op(o3) & x4
f2 = x1 & op(o1) & "(" & x2 & op(o2) & x3 & ")" & op(o3) & x4
f3 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & "(" & x3 & op(o3) & x4 & ")"
f4 = "(" & x1 & op(o1) & x2 & op(o2) & x3 & ")" & op(o3) & x4
f5 = x1 & op(o1) & "(" & x2 & op(o2) & x3 & op(o3) & x4 & ")"

If IsError(Evaluate(f1)) Then GoTo 1
If Abs(Evaluate(f1) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl) 'méthode donnée par skoobi le 23/10/08
If Err = 0 Then
[COLOR=Blue][B]solution.Add "=" & f1[/B][/COLOR]
End If
On Error GoTo 0
End If

1 If IsError(Evaluate(f2)) Then GoTo 2
If Abs(Evaluate(f2) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then
solution.Add "=" & f2
End If
On Error GoTo 0
End If

2 If IsError(Evaluate(f3)) Then GoTo 3
If Abs(Evaluate(f3) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then
solution.Add "=" & f3
End If
On Error GoTo 0
End If

3 If IsError(Evaluate(f4)) Then GoTo 4
If Abs(Evaluate(f4) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then
solution.Add "=" & f4
End If
On Error GoTo 0
End If

4 If IsError(Evaluate(f5)) Then GoTo 5
If Abs(Evaluate(f5) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then
solution.Add "=" & f5
End If
On Error GoTo 0
End If

5 Next
Next
Next
Next
Next
Next
Next
lngFinish = GetTickCount(): temps = lngFinish - lngStart
temps = temps \ 1000: Hours = temps \ 3600&
If Hours > 0 Then temps = temps - (3600& * Hours)
Minutes = temps \ 60: Seconds = temps Mod 60
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox Format(CStr(Hours & ":" & Minutes & ":" & Seconds), "hh:mm:ss")
End Sub
[COLOR=Blue][B]Sub ok_solution()
hasard = Int((Rnd * 404) + 1) * 1
MsgBox combinaison.Item(hasard)
MsgBox solution.Item(hasard)
End Sub[/B][/COLOR]

Function mini(x1, x2, x3, x4) 'créée par pierrejean le 23/10/08
tablo = Array(x1, x2, x3, x4)
For n = LBound(tablo) To UBound(tablo)
 For m = LBound(tablo) To UBound(tablo)
  If tablo(m) > tablo(n) Then
   temp = tablo(n)
   tablo(n) = tablo(m)
   tablo(m) = temp
  End If
 Next m
Next n
For n = LBound(tablo) To UBound(tablo)
  mini = mini & tablo(n)
Next n
mini = 1 * mini
End Function
Reste si c'est possible à essayer d'accélérer le code.

Mais je ne vois pas comment.

Si il y a des amateurs pour entrer dans la danse, vous êtes les bienvenus.
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Re,

Je ne vois toujours pas comment faire correspondre la formule et la combinaison avec les collection pour afficher la bonne solution.

Il suffit de ne créer que les 404 formules (en même temp que les combinaisons). Les 2 collections seront alors parallèles (même index d'item pour le couple).

On verra ça demain.

Bonne nuit à toi aussi.
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Re


j'avais anticipé ta réponse (voir mon précédent post)

Voici la dernière version.

• Ok pour afficher la bonne solution avec la bonne combinaison.


Prochaine étape :
1) créer une zone de calcul pour le joueur

2) et vérifier l'exactitude de la formule saisie

et permettre l'affichage de la solution qu'au bout de 2 minutes (par exemple)

EDITION : pièce jointe mise à jour (point 1 et 2 ok)

Je vous laisse tester, car il semble qu'il y ait parfois des bugs

(exemple si il y a un message d'erreur de VBA, il semblerai que les collections soient vidées
et dans ce cas il faut relancer Opérateurs_Staple )

Je ne comprends pas la raison de ce bug.
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Bonjour Staple, le forum,

Je t'ai embarqué dans cette histoire de collections, car je n'avais pas compris ce que tu voulais faire après avoir créé les combinaisons et les formules...

Mais finalement, n'est-il pas plus simple de créer le tableau une fois pour toutes (quitte à le reconstruire si quelqu'un le bricole) dans la feuille de calcul, puis d'aller chercher les informations dans ce tableau ?

Le tableau serait bien sûr dans une feuille masquée, voire xlVeryHidden.

Vois les morceaux de code suivants :

Code:
Dim lig As Integer
lig = 0
-------
If IsError(Evaluate(f1)) Then GoTo 1
If Abs(Evaluate(f1) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
lig = lig + 1
Range("A" & lig) = cl
Range("B" & lig) = f1
End If
End If
------------

Sub test()
Dim hasard As Integer
hasard = Int(404 * Rnd + 1)
MsgBox Sheets(1).Range("A" & hasard)
MsgBox Sheets(1).Range("B" & hasard)
End Sub

Edit : une fois créé le tableau, un petit tri par la colonne A ne lui fera pas de mal.

A+
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Bonjour job75, le forum


J'étais sur un ligne similaire sauf qu'au lieu de stocker les combinaisons dans une feuille , on les stocke dans un tableau.


Ensuite pour réduire le temps d'exécution, l'algorithme calcule toutes les solutions possibles de la combinaison qui vient de sortir.


Qu'en penses-tu?

J'essaye de modifier le code et je reviens.


Tu ne m'en voudras, si je demande aux autres grands pontes VBA du forum, s'ils ont un autre mode de résolution de ce problème mathématique.

(cela pour nourrir ma curiosité VBAistique)

Bien évidemment, une solution par formule, serait aussi très intéressante.


Une petite question personnelle pour finir:

Job75: tu as fais des études de maths?
 

Lii

XLDnaute Impliqué
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Bonjour Tous,

Pour m'être amusé ...

PS: Question ... : il s'agit de permutations ou de combinaisons
Ni les unes, ni les autres. Ce sont des Arrangements avec répétitions (9 éléments par 4 soit 9^4 ou 6561 cas).
Pourquoi vouloir refaire ce qui a été fait ?
Voilà une présentation (non testée à fond, pas le temps) avec les 404* cas dans une autre feuille.

* une seule solution retenue ; en introduisant des négatifs, il y en a plus !

au passage, beau travail Job !
 

Pièces jointes

  • LeCompteEst 24.zip
    17.5 KB · Affichages: 50

Staple1600

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Rebonjour à tous



Voici ou j'en suis

Mais il y a des bugs que je ne comprends pas

Parfois la collection de solution est vide.


Job75
: si tu peux tester, stp.

(je n'ai pas mis de zip pour job ;) )

Bien sur tout autre testeur est le bienvenu.

Edition
: fichier mis à jour sans macro Workbook_open
voir dans ce fil
Lien supprimé
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Bonjour Lii

Merci de ta participation
Pourquoi vouloir refaire ce qui a été fait ?
Pour le plaisir
Et n'est-ce pas ce que l'on fait sur ce forum ? refaire du déjà fait ;)
Combien de questions déjà posées, et déjà solutionnées ;)
EDITION
Lii: bravo pour cet autre approche.
EDITION2: je renouvelle mon appel aux formulistes
Personne n'est intéressé par une solution sans VBA tout en formules ?
 
Dernière édition:

MJ13

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Bonjour à tous,

Bon Jean marie, tu nous refait le compte est bon, c'est un challenge très intéressant que j'avais vu il y a quelque mois avec le fichier de JMPS qui utilise un algorythme de récursivité (voir ce lien La récursivité pas à pas).

Mais évite dans tes fichiers de lancer la macro à l'ouverture du fichier surtout si cela dure des minutes (on peut se demander si il n'y a pas un v....S).
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Bonjour MJ13



Moi je ne refais rien , l'inventeur du jeu c'est Robert Sun.
(D'ailleurs , son jeu est commercialisé)
http://www.24game.com/s-2-24-game-96-card-decks.aspx

J'ai juste voulu m'amuser avec VBA en votre compagnie, chers formumeurs

Désolé j'avais oublié d'effacer la procédure Workbook_Open

J'ai mis à jour le classeur dans mon autre message (plus de de WorkBook_Open)


PS: j'ai tellement l'habitude d'ouvrir les classeurs du forum sans activer les macros
que j'en oublie que tous ici n'ont pas cette même habitude.
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Re, salut Lii et Michel

J'ai regardé ta dernière version Staple, dis-moi si j'ai mal compris :

- la déterminaison des 404 combinaisons par calcul n'est plus nécessaire (pourquoi ce calcul à l'ouverture ?)

- en effet les 404 combinaisons sont stockées dans un Array où tu les as écrites une par une (c'est une bonne solution)

- tu tires au hasard l'une de ces 404 combinaisons

- tu étudie tous les cas possibles d'opérateurs et tu crée la collection "solution" quand le résultat est 24.

Pour la suite, je n'ai pas compris ce que tu veux faire avec cette collection.

Edit : pour répondre à ta question, oui j'ai une formation scientifique

A+
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Maths -algorithm- "The 24 Game" aide demandée (combinaisons/permutations)

Re , bonjour job75

Comme je le disais à MJ13


J'avais oublié de retirer la procédure dans WorkBook_Open
(c'est retiré dans la Lien supprimé

Mais dans la dernière version , comme je le disais, il arrive que la formule de solution ne s'affiche pas dans la Msgbox.


Et je ne comprends pas pourquoi.

Ce que je veux faire:

1) on tire une combinaison au hasard (ça c'est OK)
2) le joueur saisit sa formule dans un inputbox (ça c'est OK)
3) la formule est calculée dans la feuille (avec une formule nommée qui emploie EVALUER) (OK)
4) si la formule du joueur est bonne et renvoie 24
quand il clique sur [Voir la solution], une msgbox s'affiche (OK)
avec les solutions calculer à la volée par ton code VBA (parfois les solutions ne s'afficent pas)


et c'est là que parfois ca buggue.
 
Dernière édition: