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.