[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:

tototiti2008

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

re,
7 positions différentes des parenthèses dans une expression de 4 chiffres et 3 opérateurs.
si A, B, C et D les chiffres
si % les opérateurs, quels qu'ils soient :

1) A%B%C%D
2) (A%B)%C%D
3) A%B%(C%D)
4) (A%B)%(C%D)
5) (A%B%C)%D
6) A%(B%C%D)
7) A%(B%C)%D

Edit : c'est pas de ça dont vous parliez ? j'ai tapé complètement à côté ? :confused:
 
Dernière édition:

job75

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

Salut Staple, tototiti

Comme Staple l'a bien compris, l'étude de la mise en place des parenthèses est fondamentale dans ce problème. Comme indiqué dans mon post précédent, il y a 5 cas possibles, mais pour en être sûr, il faut le démontrer et les trouver.

Une 1ère remarque est que les parenthèses ne sont utiles que pour regrouper des additions ou des soustractions. Pour cette raison, il n'y a pas à étudier les cas de paires de parenthèses imbriquées.

Une 2ème remarque est que la multiplication est commutative, mais pas la division.

Cas de regroupement de 2 chiffres :
(x1°x2)°x3°x4
x1°(x2°x3)°x4
x1°x2°(x3°x4)===> pas nécessaire, car le cas précédent étudie les mêmes possibilités (cf 2ème remarque)
(x1°x2)°(x3°x4)

Cas de regroupement de 3 chiffres :
(x1°x2°x3)°x4
x1°(x2°x3°x4)

Finalement donc les 5 cas de parenthèses à étudier sont :

(x1°x2)°x3°x4
x1°(x2°x3)°x4
(x1°x2)°(x3°x4)
(x1°x2°x3)°x4
x1°(x2°x3°x4)


Il n'est pas nécessaire d'étudier le cas sans parenthèses x1°x2°x3°x4
car ses possibilités sont étudiées dans les cas avec parenthèses.

A+

Edit : excuse-moi tototiti, dans la préparation de mon post, je n'avais pas vu le tien. Tout à fait d'accord avec toi, seulement 2 des 7 cas ne sont pas nécessaires.
 
Dernière édition:

Risleure

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

Bonjour Staple, le Forum

Staple qui pose une question, je regarde car d'habitude c'est plutot lui qui y répond :D
Bref je regarde et cela ressemble à un défi dont l'utilité n'est pas immédiate mais j'aime bien.

Donc est-ce du même jeu dont parle le lien ?
Ce lien n'existe plus

Il y a un code Java et C qui semble résoudre ce jeu.

Je n'ai malheureusement pas le temps et très probablement pas les compétences mais je m'abonne à ce fil pour suivre avec attention le développement de cette affaire.

Courage
 

job75

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

Re, salut Risleure,
Pour répondre a Staple, je ne vois pas le raisonnement qui amène à la formule que tu indiques, mais elle est certainement juste. Les grandes parenthèses représentent des nombres de combinaisons.
A+
 

Staple1600

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

Rebonsoir à tous


Risleure: oui c'est le lien que j'indiquais dans mon fil de 17h25.

J'ai bien vu le progam en C mais je n'ai pas regardé les sources, j'essaye d'abord de trouver avec votre aide.

Je ne sais si la bonne solution est de stocker toutes les formules possibles dans un tableau (array)

(c'est ce que j'avais commencé à faire
d'ou ce premier post ou pierrejean avait eu le dernier mot (merci à lui)
https://www.excel-downloads.com/thr...-dans-tableau-array-comment-faire-svp.105666/)

Pour le moment, j'étudie encore le code de tototiti2008 et j'attends vos propositions.


Voici également un code trouvé sur le net qui pourrait nous aider.

Code:
Option Base 1
Option Explicit
Global Big_Array() As String
Dim CurrentRow As Long
 
Public Sub test()
 'auteur: Ger Plante
    Dim x As Variant 'this will store each number
    Dim y() As String ' this will store the operators
    Dim Op_Index1 As Integer 'an index for the operator
    Dim Op_Index2 As Integer 'an index for the operator
    Dim Op_Index3 As Integer 'an index for the operator
    Dim my_formula As String 'a string to construct the formula
    Dim Permutations() As String 'an  array to store the permutations of the numbers
    Dim Base_Numbers As String 'the numbers to check seperated by a comma
    Dim iLoop As Integer
    Dim iloop2 As Integer
    Dim InString As String 'temp string used in creating the permutatons.
     
    ReDim y(4)
    y(1) = "+"
    y(2) = "-"
    y(3) = "*"
    y(4) = "/"
     
    'Base_Numbers = "1,2,3,4,5,6"
    Base_Numbers = "1,2,3,4"
    x = Split(Base_Numbers, ",")
     
     'create all permutations of these numbers (Factorial of the number of numbers)
    ReDim Permutations(WorksheetFunction.Fact(UBound(x) + 1))
    ReDim Big_Array(WorksheetFunction.Fact(UBound(x) + 1))
    For iLoop = LBound(x) To UBound(x)
        InString = InString + Chr(48 + iLoop)
    Next iLoop
    CurrentRow = 1
    Call GetPermutation("", InString) 'creates a big array to store permutations
     
    For iLoop = LBound(Big_Array) To UBound(Big_Array)
        For iloop2 = 0 To UBound(x)
            Permutations(iLoop) = Permutations(iLoop) & x(Mid(Big_Array(iLoop), iloop2 + 1, 1)) & ","
        Next iloop2
        Permutations(iLoop) = Left(Permutations(iLoop), Len(Permutations(iLoop)) - 1)
    Next iLoop
     
     Worksheets(1).Columns("A:B").ClearContents
     
    For iLoop = 1 To UBound(Permutations)
        x = Split(Permutations(iLoop), ",")
         'if x has four numbers, then there will be three operators to use.
        For Op_Index1 = LBound(y) To UBound(y)
            For Op_Index2 = LBound(y) To UBound(y)
                For Op_Index3 = LBound(y) To UBound(y)
                    my_formula = x(0) & y(Op_Index1) & x(1) & y(Op_Index2) & x(2) & y(Op_Index3) & x(3)
                    Worksheets(1).Range("A" & Worksheets(1).Range("A65535").End(xlUp).Row + 1).Value = my_formula & "="
                    Worksheets(1).Range("B" & Worksheets(1).Range("B65535").End(xlUp).Row + 1).Value = "=" & my_formula
                Next Op_Index3
            Next Op_Index2
        Next Op_Index1
    Next iLoop
     
    Worksheets(1).Columns("A:B").AutoFit
     
End Sub
 
Sub GetPermutation(x As String, y As String)
     '   The source of this algorithm is unknown
     ' copied from ozgrid on 01 June 2006
    Dim i As Integer, j As Integer
    j = Len(y)
    If j < 2 Then
        Big_Array(CurrentRow) = x & y
        CurrentRow = CurrentRow + 1
    Else
        For i = 1 To j
            Call GetPermutation(x + Mid(y, i, 1), _
            Left(y, i - 1) + Right(y, j - i))
        Next
    End If
End Sub
 

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. Lien supprimé

Sur le site cité , voir ici, il y a les chiffres et les expressions.
Ce lien n'existe plus


EDITION: Voici les 404 chiffres et les expressions solutions
 

Pièces jointes

  • chiffreETSolutions.zip
    19.9 KB · Affichages: 57
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+