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

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\$ Mar 1, 2018 at 21:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.