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

job75

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

Re,

A mon avis il vaut mieux créer 2 collections pour les solutions donnant 24, la 1ère pour les textes des formules, la seconde pour les combinaisons de chiffres.

La méthode par tirages aléatoires est me semble-t-il à exclure. Il faudra faire 7 boucles (4 chiffres + 3 opérateurs) pour finalement étudier les formules données par les 5 cas de parenthèses.

A+
 

Staple1600

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

Re à tous


Voici pour les chiffres
(mais comment faire pour ne garder que ceux qui font 24)

Code:
Sub permut_ii()
Dim chiffres As New Collection
Dim i&, j&, k&, l&, m&, cpt&
cpt = 1
For j = 1 To 9: For k = 1 To 9: For l = 1 To 9: For m = 1 To 9
chiffres.Add j & k & l & m
cpt = cpt + 1
Next: Next: Next: Next
'MsgBox chiffres.Count
'MsgBox chiffres.Item(1)
End Sub
 

Pierrot93

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

Bonsoir à tous

aarf pas tout compris moi, je croyais qu'il fallait utiliser au moins 3 opérateurs, plus éventuellement des parenthèse afin de d'arriver a un résultat de 24. Rien dans ton code dans ce sens... j'attends la suite pour voir.... bonne soirée à tous et cogité bien, pas trop quand même.... lol
 

Staple1600

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

Bonsoir Pierrot93


Il faut avec 4 chiffres et en utilisant des expressions mathématiques régulières trouver 24 comme résultat.

Exemple:

Avec les chiffres suivants:

1126
Le seules solutions valides sont
(1+1+2)×6 = 24
(1+1)×2×6 = 24

Donc l'algorithme devra trouver toutes permutations de 4 chiffres (en ôtant les doublons)
et les solutions allant avec ces quatre chiffres.


Pour ce qui est de la partie Jeu.

Excel gènère 4 chiffres "aléatoires" entre 1 et 9 (mais avec une solution pour 24)

Et le bouton [Solution] donne les solutions possibles.
 
Dernière édition:

job75

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

Re, salut Pierrot,

Je ne suis pas sûr Staple d'être sur la bonne longueur d'onde, vu tes derniers messages, enfin voici une 1ère ébauche de macro sensée déterminer la collection "formule" qui regroupe toutes les formules "gagnantes". Il me faut 1mn30s pour l'exécuter.

Mais j'ai 2 problèmes :

1) le nombre de formules que je trouve est 14033, alors que tu indiquais 14754

2) pour l'instant je ne vois pas comment déterminer les combinaisons, en fait je n'ai pas vraiment compris ce qui est recherché.

Code:
Sub Opérateurs_Staple()
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
Dim f1, f2, f3, f4, f5 As String
Dim formule As New Collection, combinaison As New Collection
On Error Resume Next 'pour les cas de division par 0
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 Evaluate(f1) = 24 Then formule.Add f1
1 If IsError(Evaluate(f2)) Then GoTo 2
If Evaluate(f2) = 24 Then formule.Add f2
2 If IsError(Evaluate(f3)) Then GoTo 3
If Evaluate(f3) = 24 Then formule.Add f3
3 If IsError(Evaluate(f4)) Then GoTo 4
If Evaluate(f4) = 24 Then formule.Add f4
4 If IsError(Evaluate(f5)) Then GoTo 5
If Evaluate(f5) = 24 Then formule.Add f5
5 Next
Next
Next
Next
Next
Next
Next
MsgBox formule.Count
End Sub
A+
 
Dernière édition:

Staple1600

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

Bonsoir Pierrot93, job75


J'ai retenu qu'il y a 404 permutions non repétées de 4 chiffres
donnant la solution 24

(la liste de ces 4 chiffres est dans le classeur joint dans le message de 0h31)
cf. grille solutions

Sur le site cité , voir ici, il y a les chiffres et les expressions.
24 Game - Solutions to the 24 Game: Appendix a


EDITION: Voici les 404 chiffres et les expressions solutions
 

Fichiers joints

Dernière édition:

Staple1600

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

Re



Chez moi, le code de job75 s'exécute en 1m22
et chez vous ?

J'ai ajouté ceci à la fin du code
Code:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub Opérateurs_Staple_ii()
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 j As Long
Dim f1$, f2$, f3$, f4$, f5$
Dim formule As New Collection, combinaison As New Collection
 lngStart = GetTickCount()
On Error Resume Next 'pour les cas de division par 0
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 Evaluate(f1) = 24 Then formule.Add f1
1 If IsError(Evaluate(f2)) Then GoTo 2
If Evaluate(f2) = 24 Then formule.Add f2
2 If IsError(Evaluate(f3)) Then GoTo 3
If Evaluate(f3) = 24 Then formule.Add f3
3 If IsError(Evaluate(f4)) Then GoTo 4
If Evaluate(f4) = 24 Then formule.Add f4
4 If IsError(Evaluate(f5)) Then GoTo 5
If Evaluate(f5) = 24 Then formule.Add f5
5 Next
Next
Next
Next
Next
Next
Next
Application.ScreenUpdating = False
For j = 1 To formule.Count
Cells(j, 1).Formula = "=" & formule.Item(j)
Next
Application.ScreenUpdating = True
lngFinish = GetTickCount()
temps = lngFinish - lngStart ' Get milliseconds
' Convert to Seconds
temps = temps \ 1000
' Pull out HH:MM:SS
Hours = temps \ 3600&
If Hours > 0 Then temps = temps - (3600& * Hours)
Minutes = temps \ 60
Seconds = temps Mod 60
MsgBox Format(CStr(Hours & ":" & Minutes & ":" & Seconds), "hh:mm:ss")
End Sub
Avec le même temps d'exécution .

Et bravo job75, 24 s'affiche dans toutes les lignes.

Comment maintenant ne garder que les 404 permutations différentes ?
 
Dernière édition:

Staple1600

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

Re


Avant d'aller au dodo.

Une dernière info ( sauf erreur)

Il y 992 formules différentes et 404 permutations uniques de 4 chiffres ( de 1 à 9) qui donnent 24.

Mais je n'arrive pas à adapter le code de job75 pour n'avoir que celles-ci.

Bonne nuit à tous.

Et merci encore à tous les participants.
 

job75

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

Bonsoir à tous,

J'ai veillé tard, mais j'ai terminé cette macro.

Pour la comprendre, il suffit de comprendre l'un des 5 blocs (1 pour chaque cas de parenthèses).

J'ai du construire la fonction "classe" (tirée par les cheveux) qui trie à chaque fois x1 x2 x3 x4 par ordre croissant.

Enfin, outre la collection "combinaison", les combinaisons sont copiées dans la feuille de calcul. Je n'ai pas trouvé mieux pour éviter les doublons.

Le résultat est :
- 14033 formules (au lieu de 14754 indiquées par Staple)
- 403 combinaisons (au lieu de 404).

Je ne vois pas d'où peut venir la différence. Qui a raison ?

Nota : en fait On Error Resume Next n'était pas nécessaire.

Je vais dormir. Bonne nuit.

Code:
Sub Opérateurs_Staple()
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
Dim f1, f2, f3, f4, f5 As String, cl As Integer
Dim formule As New Collection, combinaison As New Collection
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 Evaluate(f1) = 24 Then
formule.Add f1
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

1 If IsError(Evaluate(f2)) Then GoTo 2
If Evaluate(f2) = 24 Then
formule.Add f2
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

2 If IsError(Evaluate(f3)) Then GoTo 3
If Evaluate(f3) = 24 Then
formule.Add f3
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

3 If IsError(Evaluate(f4)) Then GoTo 4
If Evaluate(f4) = 24 Then
formule.Add f4
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

4 If IsError(Evaluate(f5)) Then GoTo 5
If Evaluate(f5) = 24 Then
formule.Add f5
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

5 Next
Next
Next
Next
Next
Next
Next
MsgBox "Formules " & formule.Count
MsgBox "Combinaisons " & combinaison.Count
End Sub

Function classe(x1, x2, x3, x4)
y1 = 1 * (x1 & x2 & x3 & x4)
y2 = 1 * (x1 & x2 & x4 & x3)
y3 = 1 * (x1 & x3 & x2 & x4)
y4 = 1 * (x1 & x3 & x4 & x2)
y5 = 1 * (x1 & x4 & x2 & x3)
y6 = 1 * (x1 & x4 & x3 & x2)
y7 = 1 * (x2 & x1 & x3 & x4)
y8 = 1 * (x2 & x1 & x4 & x3)
y9 = 1 * (x2 & x3 & x1 & x4)
y10 = 1 * (x2 & x3 & x4 & x1)
y11 = 1 * (x2 & x4 & x1 & x3)
y12 = 1 * (x2 & x4 & x3 & x1)
y13 = 1 * (x3 & x1 & x2 & x4)
y14 = 1 * (x3 & x1 & x4 & x2)
y15 = 1 * (x3 & x2 & x1 & x4)
y16 = 1 * (x3 & x2 & x4 & x1)
y17 = 1 * (x3 & x4 & x1 & x2)
y18 = 1 * (x3 & x4 & x2 & x1)
y19 = 1 * (x4 & x1 & x2 & x3)
y20 = 1 * (x4 & x1 & x3 & x2)
y21 = 1 * (x4 & x2 & x1 & x3)
y22 = 1 * (x4 & x2 & x3 & x1)
y23 = 1 * (x4 & x3 & x1 & x2)
y24 = 1 * (x4 & x3 & x2 & x1)
classe = Application.Min(y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20, y21, y22, y23, y24)
End Function
 
Dernière édition:

job75

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

Bonjour à tous,

Je sais pourquoi le nombre de combinaisons est 403 au lieu de 404.

En comparant avec les solutions fournies par Staple, j'ai trouvé que la combinaison manquante est 3388.

Il n'y a qu'une formule : 8÷(3-8÷3), et il s'agit certainement d'un problème d'arrondi dû à la fonction Evaluate. Reste à voir comment récupérer cette combinaison.

Quant aux nombres de formules différents, c'est une question d'algorithme : je constate que les solutions de Staple utilisent des parenthèses imbriquées alors que ma macro ne les utilise pas...

A+
 

job75

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

Re,

Avec la macro suivante, on récupère la combinaison 3388.

Le résultat est maintenant :
- 14063 formules
- 404 combinaisons.

L'erreur d'arrondi est inférieure à 10^-13.

Reste 2 questions, je pense ouvrir 2 autres fils :
- comment construire la fonction "classe" sans écrire tous les cas possibles
- comment se passer de la feuille de calcul pour les combinaisons.

Code:
Sub Opérateurs_Staple()
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
Dim f1, f2, f3, f4, f5 As String, cl As Integer
Dim formule As New Collection, combinaison As New Collection
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 [COLOR="Red"]Abs(Evaluate(f1) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f1
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

1 If IsError(Evaluate(f2)) Then GoTo 2
If [COLOR="Red"]Abs(Evaluate(f2) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f2
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

2 If IsError(Evaluate(f3)) Then GoTo 3
If [COLOR="Red"]Abs(Evaluate(f3) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f3
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

3 If IsError(Evaluate(f4)) Then GoTo 4
If [COLOR="Red"]Abs(Evaluate(f4) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f4
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

4 If IsError(Evaluate(f5)) Then GoTo 5
If [COLOR="Red"]Abs(Evaluate(f5) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f5
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

5 Next
Next
Next
Next
Next
Next
Next
MsgBox "Formules " & formule.Count
MsgBox "Combinaisons " & combinaison.Count
End Sub

Function classe(x1, x2, x3, x4)
y1 = 1 * (x1 & x2 & x3 & x4)
y2 = 1 * (x1 & x2 & x4 & x3)
y3 = 1 * (x1 & x3 & x2 & x4)
y4 = 1 * (x1 & x3 & x4 & x2)
y5 = 1 * (x1 & x4 & x2 & x3)
y6 = 1 * (x1 & x4 & x3 & x2)
y7 = 1 * (x2 & x1 & x3 & x4)
y8 = 1 * (x2 & x1 & x4 & x3)
y9 = 1 * (x2 & x3 & x1 & x4)
y10 = 1 * (x2 & x3 & x4 & x1)
y11 = 1 * (x2 & x4 & x1 & x3)
y12 = 1 * (x2 & x4 & x3 & x1)
y13 = 1 * (x3 & x1 & x2 & x4)
y14 = 1 * (x3 & x1 & x4 & x2)
y15 = 1 * (x3 & x2 & x1 & x4)
y16 = 1 * (x3 & x2 & x4 & x1)
y17 = 1 * (x3 & x4 & x1 & x2)
y18 = 1 * (x3 & x4 & x2 & x1)
y19 = 1 * (x4 & x1 & x2 & x3)
y20 = 1 * (x4 & x1 & x3 & x2)
y21 = 1 * (x4 & x2 & x1 & x3)
y22 = 1 * (x4 & x2 & x3 & x1)
y23 = 1 * (x4 & x3 & x1 & x2)
y24 = 1 * (x4 & x3 & x2 & x1)
classe = Application.Min(y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20, y21, y22, y23, y24)
End Function
A+
 

job75

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

Re,

Voilà une 1ère amélioration : la fonction "classe" a été remplacée par la fonction "mini" de pierrejean :

Code:
Sub Opérateurs_Staple()
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
Dim f1, f2, f3, f4, f5 As String, cl As Integer
Dim formule As New Collection, combinaison As New Collection
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
formule.Add f1
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

1 If IsError(Evaluate(f2)) Then GoTo 2
If Abs(Evaluate(f2) - 24) < 10 ^ -13 Then
formule.Add f2
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

2 If IsError(Evaluate(f3)) Then GoTo 3
If Abs(Evaluate(f3) - 24) < 10 ^ -13 Then
formule.Add f3
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

3 If IsError(Evaluate(f4)) Then GoTo 4
If Abs(Evaluate(f4) - 24) < 10 ^ -13 Then
formule.Add f4
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

4 If IsError(Evaluate(f5)) Then GoTo 5
If Abs(Evaluate(f5) - 24) < 10 ^ -13 Then
formule.Add f5
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If

5 Next
Next
Next
Next
Next
Next
Next
MsgBox "Formules " & formule.Count
MsgBox "Combinaisons " & combinaison.Count
End Sub

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
End Function
A+
 

job75

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

Re,

Et voici la 2ème amélioration donnée par skoobi : il n'y a plus besoin de la feuille de calcul pour déterminer les combinaisons.

J'ai laissé dans la macro les lignes qui remplissent la feuille, mais on peut sans problème les retirer.

Code:
Sub Opérateurs_Staple()
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
Dim f1, f2, f3, f4, f5 As String, cl As Integer
Dim formule As New Collection, combinaison As New Collection
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
formule.Add f1
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 Range("A" & combinaison.Count) = cl
On Error GoTo 0
End If

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

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

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

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

5 Next
Next
Next
Next
Next
Next
Next
MsgBox "Formules " & formule.Count
MsgBox "Combinaisons " & combinaison.Count
End Sub

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
End Function
A+
 

Staple1600

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

Bonsoir à tous



Job75: félicitations pour ta persévérance (même si tu as du te coucher tard)

Mais cela fait plaisir de voir le résultat d'un bataillon de neurones en découdre avec VBA.

Merci aussi à skoobi et pierrejean d'avoir adjoint vos neurones à ceux de job75.


Je m'en vais tester le dernier code de job75.



PS: job75: dans quel fil pierrejean a t'il posté sa fonction mini, j'ai eu beau lire ce fil et celui que tu as ouvert , je n'ai pas vu trace de pierrejean.
 

Staple1600

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

Re


Merci job75 pour les liens.


J'ajoute à mes remerciements la personne suivante

Wilfried42 (merci à toi).


Maintenant , il reste la partie Jeu

(Tirer 4 chiffres au hasard dans ceux qui solutionnent x1 x2 x3 x4 = 24
puis pouvoir comparer la réponse avec la bonne solution)

Je vais travailler un peu de mon côté.
 

Staple1600

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

Re



Le problème auquel je viens de me confronter

Avec ce code
MsgBox combinaison.Item(((Rnd * 404) + 1))

On tire un combinaison au hasard, mais à chaque fois, qu'on veut jouer à nouveau, il faut attendre environ 1m10

Dans ce cas, faut-il stocker dans un tableau les 404 combinaisons
(et dans un autre les 404 formules)

Un autre problème, c'est qu'il peut y avoir plusieurs solutions
(voir le classeur joint dans le message de 22h21)

Je m'en vais créer deux tableaux de ce pas.

A+ et bonne soirée à tous
 

job75

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

Re Staple

Re
Je m'en vais créer deux tableaux de ce pas.
Les "tableaux" sont déjà créés (les 2 collections). Pour qu'ils puissent être utilisés sans recalcul par d'autres macros, il suffit d'écrire (tu le sais bien...) en haut de la page de code :

Public formule As New Collection
Public combinaison As New Collection


Le problème c'est que je n'ai pas créé de correspondance entre les 2 collections. Je crois que c'est possible, mais il faudrait que je travaille la question. Tu sais peut-être comment faire ?

Maintenant, à part le tirage aléatoire, je n'ai pas compris en quoi consiste le jeu. Tu peux m'expliquer ?

A+
 

Staple1600

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

Re



Snif , snif


Job75: J'aurais du te lire avant , je viens de me coltiner à la mimine de créer deux tableaux (lol)

Bon bah je retourne modifier ma pièce jointe.

Tu peux néanmoins regarder comment j'envisage la feuille JEU

(PS: j'ai ajouté ton VBA (légèrement modifié)
 

Fichiers joints

Dernière édition:

Staple1600

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

Re


Le jeu: 4 chiffres s'affichent de manière aléatoire dans 4 cellules.

Le joueur doit trouver la formule qui aboutit à 24.

Un bouton [Vérifier l'expression] vérifie la validité mathématique de l'expression saisie par le joueur.


Un bouton Solution permet d'afficher la solution.



J'ai modifié ton code pour afficher les formules sur la même ligne que les combis
mais je ne sais pas comment lire la collection sans passer par le stockage sur la feuille pour le moment.

C'est pour cela que je partais sur l'idée de tableaux.



PS: Quel idiot je fais , j'étais content de ton algo et ca m'embetait
de ne pas l'utiliser.
 
Dernière édition:

Discussions similaires


Haut Bas