An Excel VBA macro that solves MasterMind

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.

Advertisements

About Dimitrios Kalemis

I am a systems engineer specializing in Microsoft products and technologies. I am also an author. Please visit my blog to see the blog posts I have written, the books I have written and the applications I have created. I definitely recommend my blog posts under the category "Management", all my books and all my applications. I believe that you will find them interesting and useful. I am in the process of writing more blog posts and books, so please visit my blog from time to time to see what I come up with next. I am also active on other sites; links to those you can find in the "About me" page of my blog.
This entry was posted in Development. Bookmark the permalink.