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
- Main Sub
- Make the Move Sub
- Check for Win (general) Function
- Functions to check horizontal, vertical or diagonal wins
- 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