I have always loved MasterMind. I started with MasterMind using a board version that had six colors and four positions. I still have this game and I always wanted to create a program that solved this puzzle. Here I present an Excel VBA macro, that I wrote in Excel 97, that solves MasterMind. My macro assumes that there are six colors and four positions. I used the name “Exact Matches” for the number of correct colors that are in correct positions and the term “Near Matches” for the number of correct colors that are in incorrect positions. Of course, the sum of Exact Matches plus Near Matches will always be from zero to four. The macro suggests to the user a combination of four colors and the user responds by entering the number of Exact Matches and the number of Near Matches. When the number of Exact Matches that the user enters is four, the game is ended, because the solution has been found.
Actually, in order to keep things simple, by six “colors” I mean the numbers from 1 to 6. So instead of the opponent having (in his mind) a secret combination of four colors out of six, the opponent chooses a secret combination of four numbers out of the numbers 1, 2, 3, 4, 5 and 6. So, a secret combination could be 2 3 5 2. Another one could be 6 1 1 3 and so on. My macro tries to find the secret combination, by suggesting combinations to the opponent and by accepting the opponent’s responses for the Exact Matches and the Near Matches.
My macro consists of a form and a module. The Excel grid is not used at all. When you initiate the macro, the form appears with the first suggestion. When the user enters the Exact Matches and the Near Matches and presses OK, the macro takes this input into account and shows a second suggestion and so on, until the user enters the number 4 for Exact Matches and the number 0 for Near Matches and presses OK. Actually, I have hardcoded a maximum number of suggestions (i.e. tries, attempts), that the macro will perform before giving up and this number is 20. But the macro will certainly find the secret combination in way less than 20 attempts.
My macro works as follows: First of all I calculate all the possible combinations. (In this blog post, I use the word combinations rather loosely, because they are actually permutations.) Their total number is 6 x 6 x 6 x 6 = 1296. Then, I choose one of these randomly to offer as the first suggestion. I choose randomly, because I have better chances that the opponent will not game the macro, than if I would suggest the first combination blindly (which would be 1 1 1 1 always). After the user inputs the Exact Matches and the Near Matches, I loop through all the combinations and for each one I check the following: “If the opponent had chosen this particular combination as the secret combination, would I get the same Exact Matches and Near Matches for my suggestion?” If yes, I keep this particular combination, else I “erase” it. So in the end of the loop, I have less than 1296 combinations. From these remaining combinations I choose the first one (but it would be better if I would continue to draw one randomly) and suggest it to the opponent. After the user enters the Exact Matches and Near Matches for this second suggestion, I loop through the remaining combinations and again I try to find exactly what I tried to find before: “If the opponent had chosen this particular combination as the secret combination, would I get the same Exact Matches and Near Matches for my suggestion?” If yes, I keep this particular combination, else I “erase” it. So, in the end of the second loop I have less combinations and so on, until the secret combination is found and the puzzle is solved.
In the previous paragraph you may have noticed that I enclosed the word “erase” in quotation marks. This is because I do not actually erase the invalid combinations, I just flagged them as such and for this I use an attribute of the mySet type called myParticipate.
My macro consists of a userform named formMasterMind and a module whose name is not important Let us call the module MasterMind.
A screenshot of formMasterMind during desing time follows:
formMasterMind has a readonly listbox named listboxPastTries, a readonly textbox named textboxCurrentTry, a textbox named textboxExactMatches, a textbox named textboxNearMatches and a commandbuttton named buttonOk. formMasterMind‘s code follows:
Option Explicit
Private Sub buttonOk_Click()
If Not IsNumeric(textboxExactMatches.Text) Then
MsgBox "Please enter Exact Matches"
Exit Sub
End If
If Not IsNumeric(textboxNearMatches.Text) Then
MsgBox "Please enter Near Matches"
Exit Sub
End If
If CInt(textboxExactMatches.Text) < 0 Or CInt(textboxExactMatches.Text) > POSSIBLEPOSITIONS Then
MsgBox "Please enter correct number of Exact Matches"
Exit Sub
End If
If CInt(textboxNearMatches.Text) < 0 Or CInt(textboxNearMatches.Text) > POSSIBLEPOSITIONS Then
MsgBox "Please enter correct number of Near Matches"
Exit Sub
End If
If CInt(textboxExactMatches.Text) + CInt(textboxNearMatches.Text) > POSSIBLEPOSITIONS Then
MsgBox "Please enter correct number of Exact and Near Matches"
Exit Sub
End If
listboxPastTries.AddItem textboxCurrentTry.Text & " " & _
textboxExactMatches.Text & " " & _
textboxNearMatches.Text
formMasterMind.Hide
End Sub
The MasterMind module’s code follows:
Option Explicit
Public Const POSSIBLEPOSITIONS = 4 'it is not dynamic
Public Const POSSIBLECOLORS = 6 'The loops must start from 1.
Public Const POSSIBLECOMBINATIONS = 1296 '6^4
Public Const POSSIBLETRIES = 20
Type mySet
myPosition1 As Integer
myPosition2 As Integer
myPosition3 As Integer
myPosition4 As Integer
myParticipate As Boolean
End Type
Type myTry
myPosition1 As Integer
myPosition2 As Integer
myPosition3 As Integer
myPosition4 As Integer
myExactCount As Integer
myNearCount As Integer
End Type
Dim myCombinations() As mySet
Dim myTries() As myTry
Public Sub PlayMasterMind()
Dim myCombinationsCounter As Long
Dim myTriesCounter As Integer
Dim myParticipateCounter As Long
Dim myPosition1, myPosition2, myPosition3, myPosition4 As Integer
Dim firstTimeIn As Boolean
'Clear environment
ReDim myCombinations(1 To POSSIBLECOMBINATIONS) As mySet
ReDim myTries(1 To POSSIBLETRIES) As myTry
'Fill myCombinations array with all combinations
myCombinationsCounter = 1
For myPosition1 = 1 To POSSIBLECOLORS
For myPosition2 = 1 To POSSIBLECOLORS
For myPosition3 = 1 To POSSIBLECOLORS
For myPosition4 = 1 To POSSIBLECOLORS
myCombinations(myCombinationsCounter).myPosition1 = myPosition1
myCombinations(myCombinationsCounter).myPosition2 = myPosition2
myCombinations(myCombinationsCounter).myPosition3 = myPosition3
myCombinations(myCombinationsCounter).myPosition4 = myPosition4
myCombinations(myCombinationsCounter).myParticipate = True
myCombinationsCounter = myCombinationsCounter + 1
Next myPosition4
Next myPosition3
Next myPosition2
Next myPosition1
myTriesCounter = 1
firstTimeIn = True
Do
formMasterMind.textboxCurrentTry.Text = ""
formMasterMind.textboxExactMatches.Text = ""
formMasterMind.textboxNearMatches.Text = ""
'Propose a combination.
'First time in, propose a random one.
'From then on, propose the first one that you find.
If firstTimeIn = True Then
firstTimeIn = False
Randomize
myCombinationsCounter = Int((POSSIBLECOMBINATIONS * Rnd) + 1) 'Generate random value between 1 and POSSIBLECOMBINATIOS
myTries(myTriesCounter).myPosition1 = myCombinations(myCombinationsCounter).myPosition1
myTries(myTriesCounter).myPosition2 = myCombinations(myCombinationsCounter).myPosition2
myTries(myTriesCounter).myPosition3 = myCombinations(myCombinationsCounter).myPosition3
myTries(myTriesCounter).myPosition4 = myCombinations(myCombinationsCounter).myPosition4
formMasterMind.textboxCurrentTry.Text = _
CStr(myCombinations(myCombinationsCounter).myPosition1) & " " & _
CStr(myCombinations(myCombinationsCounter).myPosition2) & " " & _
CStr(myCombinations(myCombinationsCounter).myPosition3) & " " & _
CStr(myCombinations(myCombinationsCounter).myPosition4)
Else
For myCombinationsCounter = 1 To POSSIBLECOMBINATIONS
If myCombinations(myCombinationsCounter).myParticipate = True Then
myTries(myTriesCounter).myPosition1 = myCombinations(myCombinationsCounter).myPosition1
myTries(myTriesCounter).myPosition2 = myCombinations(myCombinationsCounter).myPosition2
myTries(myTriesCounter).myPosition3 = myCombinations(myCombinationsCounter).myPosition3
myTries(myTriesCounter).myPosition4 = myCombinations(myCombinationsCounter).myPosition4
formMasterMind.textboxCurrentTry.Text = _
CStr(myCombinations(myCombinationsCounter).myPosition1) & " " & _
CStr(myCombinations(myCombinationsCounter).myPosition2) & " " & _
CStr(myCombinations(myCombinationsCounter).myPosition3) & " " & _
CStr(myCombinations(myCombinationsCounter).myPosition4)
Exit For
End If
Next myCombinationsCounter
End If
'Find how many valid combinations exist so far
myParticipateCounter = 0
For myCombinationsCounter = 1 To POSSIBLECOMBINATIONS
If myCombinations(myCombinationsCounter).myParticipate = True Then
myParticipateCounter = myParticipateCounter + 1
End If
Next myCombinationsCounter
formMasterMind.textboxCurrentTry.Text = formMasterMind.textboxCurrentTry.Text & " out of " & CStr(myParticipateCounter)
formMasterMind.Show ' This stops the code until the Ok button in the form is pressed
If Not IsNumeric(formMasterMind.textboxExactMatches) Then
Exit Do
End If
If Not IsNumeric(formMasterMind.textboxNearMatches) Then
Exit Do
End If
myTries(myTriesCounter).myExactCount = CInt(formMasterMind.textboxExactMatches)
myTries(myTriesCounter).myNearCount = CInt(formMasterMind.textboxNearMatches)
If myTries(myTriesCounter).myExactCount = POSSIBLEPOSITIONS Then
MsgBox "Combination Found. The program will now stop."
Exit Do
End If
'Analyze this try's data
Dim myResult As Boolean
For myCombinationsCounter = 1 To POSSIBLECOMBINATIONS
If myCombinations(myCombinationsCounter).myParticipate = True Then
myResult = findRelation(myCombinationsCounter, myTriesCounter)
If Not myResult Then myCombinations(myCombinationsCounter).myParticipate = False
End If
Next myCombinationsCounter
myTriesCounter = myTriesCounter + 1
If myTriesCounter > POSSIBLETRIES Then
MsgBox "You used all your availiable tries. The program will now stop."
Exit Do
End If
Loop
'Clear Environment
formMasterMind.listboxPastTries.Clear
formMasterMind.textboxCurrentTry = ""
formMasterMind.textboxExactMatches = ""
formMasterMind.textboxNearMatches = ""
End Sub
Function findRelation(ByVal myCombinationsCounter As Long, ByVal myTriesCounter As Integer) As Boolean
Dim myExactCount As Integer
Dim myNearCount As Integer
Dim a1, a2, a3, a4, b1, b2, b3, b4, b5, b6 As Integer
myExactCount = 0
myNearCount = 0
a1 = myCombinations(myCombinationsCounter).myPosition1
a2 = myCombinations(myCombinationsCounter).myPosition2
a3 = myCombinations(myCombinationsCounter).myPosition3
a4 = myCombinations(myCombinationsCounter).myPosition4
b1 = myTries(myTriesCounter).myPosition1
b2 = myTries(myTriesCounter).myPosition2
b3 = myTries(myTriesCounter).myPosition3
b4 = myTries(myTriesCounter).myPosition4
b5 = myTries(myTriesCounter).myExactCount
b6 = myTries(myTriesCounter).myNearCount
If a1 = b1 Then
myExactCount = myExactCount + 1
a1 = 0
b1 = 0
End If
If a2 = b2 Then
myExactCount = myExactCount + 1
a2 = 0
b2 = 0
End If
If a3 = b3 Then
myExactCount = myExactCount + 1
a3 = 0
b3 = 0
End If
If a4 = b4 Then
myExactCount = myExactCount + 1
a4 = 0
b4 = 0
End If
If a1 <> 0 Then
If a1 = b2 Then
myNearCount = myNearCount + 1
b2 = 0
Else
If a1 = b3 Then
myNearCount = myNearCount + 1
b3 = 0
Else
If a1 = b4 Then
myNearCount = myNearCount + 1
b4 = 0
End If
End If
End If
End If
If a2 <> 0 Then
If a2 = b1 Then
myNearCount = myNearCount + 1
b1 = 0
Else
If a2 = b3 Then
myNearCount = myNearCount + 1
b3 = 0
Else
If a2 = b4 Then
myNearCount = myNearCount + 1
b4 = 0
End If
End If
End If
End If
If a3 <> 0 Then
If a3 = b1 Then
myNearCount = myNearCount + 1
b1 = 0
Else
If a3 = b2 Then
myNearCount = myNearCount + 1
b2 = 0
Else
If a3 = b4 Then
myNearCount = myNearCount + 1
b4 = 0
End If
End If
End If
End If
If a4 <> 0 Then
If a4 = b1 Then
myNearCount = myNearCount + 1
b1 = 0
Else
If a4 = b2 Then
myNearCount = myNearCount + 1
b2 = 0
Else
If a4 = b3 Then
myNearCount = myNearCount + 1
b3 = 0
End If
End If
End If
End If
If myExactCount = b5 And myNearCount = b6 Then
findRelation = True
Else
findRelation = False
End If
End Function
It is obvious that for each suggestion and its corresponding Exact Matches and Near Matches, the remaining combinations need to be examined, but previous suggestions and their corresponding Exact Matches and Near Matches need not be re-examined. After each suggestion and its corresponding number matches are processed, the combinations are reduced, so there is no reason to re-examine past suggestions. Only the last suggestions and its matches need to be examined in the loop.
Also, I would like to note a problem that I had when I was constructing the function findRelation (by the way, another poor name from my part) that is used to find whether a combination is still valid or should be erased. But first, I will digress a little. I was always passionate about MasterMind and when I was in the army (in the year 1994), I had the idea of creating a program that would solve it. Now, in the army, our superiors would always try to find ways to make our lives miserable. One of their little tortures was the following: In the army, sometimes you can leave the army campus for a few hours and then return. This happened once every few days for each soldier. Now before someone could leave they had to obtain an official paper that allowed them to leave. So, our superiors would have us waiting for hours until they gave us the official papers. During these hours, which would occur once a week or a fortnight, I kept little pieces of blank paper with me and I would write the program in C, as I was waiting. When I finished my army service for good, I took these little pieces of paper and implemented the program in C in Unix. Yes, I know, disgusting! Anyway, Unix was available for me at that point, so I had to make do. My program was a command line application that worked like this macro. It used numbers instead of colors, it was statically programmed for 4 positions and 6 colors etc. I also used a procedure similar to findRelation to weed out the invalid combinations. That C program worked flawlessly. Now, when I created the macro, I thought that the exact logic of this function would work in Excel VBA. But it did not. In Excel VBA, the logic did not run correctly. Although my earlier C code was correct and my corresponding VBA code was correct, findRelation would produce incorrect results. I researched the problem and found that this was because of a bug in the VBA interpreter. My if-statements were deeply nested and the VBA interpreter handled them incorrectly instead of producing an error. So, I changed my VBA code a bit (rephrasing the parts that seemed to confuse the VBA interpreter) until the function worked. So, in general, everyone should be extra careful with their VBA code and they should test it a lot. Trust the VBA interpreter only as far as you have tested it.
Now there are ways that this macro can be improved. First of all, it would benefit from being rewritten in a different language, outside of Excel. Then, as I said, it would be best if, not only the first, but each suggestion would be chosen randomly from the remaining combinations (this is actually a small and easy change). In addition, the number of attempts should not be fixed; the user should be able to try as many times as she wants. Also, it would be great if I would make the program more dynamic, meaning that the number of colors and the number of positions would be chosen at runtime. For example, someone may wish to solve a MasterMind puzzle with five positions and eight colors. My program should be able to accommodate that. And of course, it would be great if the user could choose real colors instead of numbers. And it would be great if the program would come both as an application and as a Web site.
I do not know if I will ever pursue making these changes. At this stage, the macro is static (it only accommodates 4 positions and 6 colors) and boring (it has numbers in place of colors). But, anyway, it is an Excel VBA macro that solves MasterMind, and I like it because it is my brainchild, no matter how trivial it may be.
Dimitrios Kalemis 