3
\$\begingroup\$

I've been trying to mess around with boolean arrays in VBA since I started to try to write an algorithm to solve sudoku puzzles. I thought I'd first try to solve codeabbey tic-tac-toe. I might be reinventing the wheel here, but humor me please.

Goal is to output the winning move number, or 0 if it's a tie.

Here is sample input:

3 7 5 4 1 9 2 8 3 6 5 1 3 7 6 4 2 9 8 5 1 2 8 6 4 7 3 9 answer: 7 6 0

It's set up on a spreadsheet with A1 the number of games and each game as a space-delimited string in the following cells. Not too important, as I just bring it in and then push the end result out (C1).

That being said, because I'm looking at using this style for another type of puzzle, I think I may have overkilled it - I could probably completely skip CheckWin and just run all three win scenarios each time, but that would be sort of ridiculous with 81 boxes instead of 9 boxes.

Booleans are always initialized as False, which will explain the non-result for some functions.

There is

  1. Main Sub
  2. Make the Move Sub
  3. Check for Win (general) Function
  4. Functions to check horizontal, vertical or diagonal wins
  5. A Sub to reset my boolean arrays to all False

I'm passing my arrays ByRef so I can return a single Boolean result from my functions. Plus they need to persist anyway.

I know, there are a lot of magic numbers and no Constants.

Option Explicit Public Sub FindTicTacToeWinningMove() Dim results As String Dim numberOfGames As Long Dim index As Long numberOfGames = Sheet1.Cells(1, 1) Dim gameNumber As Long Dim moveNumber As Long Dim xBoxes(1 To 9) As Boolean Dim oBoxes(1 To 9) As Boolean Dim rawMoves As Variant Dim moves(1 To 9) As String For gameNumber = 2 To numberOfGames + 1 ClearArrays xBoxes, oBoxes rawMoves = Split(Sheet1.Cells(gameNumber, 1), " ") For index = LBound(rawMoves) To UBound(rawMoves) moves(index + 1) = rawMoves(index) Next For moveNumber = 1 To 9 Select Case moveNumber Mod 2 Case 1 If MakeMove(xBoxes, moves(moveNumber), moveNumber) Then results = results & " " & moveNumber GoTo Win End If Case 0 If MakeMove(oBoxes, moves(moveNumber), moveNumber) Then results = results & " " & moveNumber GoTo Win End If End Select Next results = results & " " & 0 Win: Next Sheet1.Cells(1, 3) = Trim$(results) End Sub Private Function MakeMove(ByRef moveArray() As Boolean, ByVal position As Long, ByVal moveNumber As Long) As Boolean moveArray(position) = True If moveNumber < 5 Then MakeMove = False Exit Function End If MakeMove = CheckWin(moveArray, position) End Function Private Function CheckWin(ByRef moveArray() As Boolean, ByVal position As Long) As Boolean Select Case position Mod 3 Case 1 If moveArray(position + 1) Then If CheckHorizontal(moveArray, position) Then GoTo Win End If If position = 7 Then If moveArray(position - 3) Then If CheckVertical(moveArray, position) Then GoTo Win End If ElseIf moveArray(position + 3) Then If CheckVertical(moveArray, position) Then GoTo Win End If Case 2 If moveArray(position - 1) Then If CheckHorizontal(moveArray, position) Then GoTo Win End If If position = 2 Then If moveArray(position + 3) Then If CheckVertical(moveArray, position) Then GoTo Win End If ElseIf moveArray(position - 3) Then If CheckVertical(moveArray, position) Then GoTo Win End If Case 0 If moveArray(position - 1) Then If CheckHorizontal(moveArray, position) Then GoTo Win End If If position = 9 Then If moveArray(position - 3) Then If CheckVertical(moveArray, position) Then GoTo Win End If ElseIf moveArray(position + 3) Then If CheckVertical(moveArray, position) Then GoTo Win End If End Select If position Mod 2 = 1 Then If CheckDiagonal(moveArray) Then GoTo Win End If Exit Function Win: CheckWin = True End Function Private Function CheckHorizontal(ByRef moveArray() As Boolean, ByVal position As Long) As Boolean Select Case position Case 1, 2, 3 If moveArray(1) And moveArray(2) And moveArray(3) Then CheckHorizontal = True Case 4, 5, 6 If moveArray(4) And moveArray(5) And moveArray(6) Then CheckHorizontal = True Case 7, 8, 9 If moveArray(7) And moveArray(8) And moveArray(9) Then CheckHorizontal = True End Select End Function Private Function CheckVertical(ByRef moveArray() As Boolean, ByVal position As Long) As Boolean Select Case position Case 1, 4, 7 If moveArray(1) And moveArray(4) And moveArray(7) Then CheckVertical = True Case 2, 5, 8 If moveArray(2) And moveArray(5) And moveArray(8) Then CheckVertical = True Case 3, 6, 9 If moveArray(3) And moveArray(6) And moveArray(9) Then CheckVertical = True End Select End Function Private Function CheckDiagonal(ByRef moveArray() As Boolean) As Boolean If moveArray(5) And moveArray(1) And moveArray(9) Then CheckDiagonal = True If moveArray(5) And moveArray(3) And moveArray(7) Then CheckDiagonal = True End Function Private Sub ClearArrays(ByRef firstArray() As Boolean, ByRef secondArray() As Boolean) Dim index As Long For index = 1 To 9 firstArray(index) = False secondArray(index) = False Next End Sub
\$\endgroup\$
0

1 Answer 1

Reset to default
2
\$\begingroup\$

Excellent job on this coding challenge.

ClearArrays: Subroutine

This Subroutine isn't needed. Use the built in VBA Erase method instead.

Erase xBoxes

Erase oBoxes

FindTicTacToeWinningMove: Subroutine

As a personal preference, I would have just used 0 based Arrays.

rawMoves = Split(Sheet1.Cells(gameNumber, 1), " ") For index = LBound(rawMoves) To UBound(rawMoves) moves(index + 1) = rawMoves(index) Next

In the next code blocK I would:

  • Replace the Select Case with an If Else statement. Select Case statements are pretty lengthy to use for just 2 cases.

  • GoTo statements should be avoided unless writing an Error Handler. You could replace GoTo Win with Exit For. The trick is to take advantage of how a For Next loop works. After Next the counter is incremented and the exit condition is checked. If the counter is greater than the exit condition then the loop exits. If For moveNumber = 1 To 9 runs uninterrupted then moveNumber = 10 after the loop is complete else moveNumber will equal between 1 and 9 depending on when Exit For was executed.

 For moveNumber = 1 To 9 Select Case moveNumber Mod 2 Case 1 If MakeMove(xBoxes, moves(moveNumber), moveNumber) Then results = results & " " & moveNumber GoTo Win End If Case 0 If MakeMove(oBoxes, moves(moveNumber), moveNumber) Then results = results & " " & moveNumber GoTo Win End If End Select Next

I more condensed way to write the code above is as follows:

 For moveNumber = 1 To 9 If moveNumber Mod 2 Then If MakeMove(xBoxes, moves(moveNumber), moveNumber) Then Exit For Else If MakeMove(oBoxes, moves(moveNumber), moveNumber) Then Exit For End If Next results = results & " " & IIf(moveNumber = 10, 0, moveNumber)

Of course we could condense it further but this looks a like ridiculous:

 For moveNumber = 1 To 9 If MakeMove(IIf(CBool(moveNumber Mod 2), xBoxes, oBoxes), moves(moveNumber), moveNumber) Then Exit For Next results = results & " " & IIf(moveNumber = 10, 0, moveNumber)

MakeMove: Function

It is best practice to have Boolean Functions sound like a question (e.g. isWin, hasWon, isGameOver). Following this rule, you should call MakeMove and CheckWin separately. That being said, I seen plenty of game code that had Move return a Boolean.

CheckWin, CheckHorizontal, CheckDiagonal

CheckWin is over complicated. There is no reason to try and optimize the codes performance. There are only 8 sets of 3 positions in the array to test.

Private Function hasWon(ByRef moveArray() As Boolean) As Boolean Dim sequence As Variant Dim a As Long, b As Long, c As Long For Each sequence In Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9), _ Array(1, 4, 7), Array(2, 5, 8), Array(3, 6, 9), _ Array(5, 1, 9), Array(5, 3, 7)) hasWon = moveArray(sequence(0)) * moveArray(sequence(1)) * moveArray(sequence(2)) If hasWon Then Exit Function Next End Function

Note: The result of multiplying the 3 positions in the Boolean Array together will be 0 if any of the conditions are False and non-zero if all conditions are True. This is how Boolean logic works. Alternatively, I could have just used And instead of *.

\$\endgroup\$
1
  • \$\begingroup\$ All good advice. I couldn't think of Clear - I kept coming back to VB.NET functions. That's something I definitely overlooked. \$\endgroup\$ Commented Mar 1, 2018 at 21:55

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.