trjhtr

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

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 *.