## Knight’s Tour

The knight’s tour is a chess puzzle where you have to move a knight around a chess board so that it visits each square once. An Excel worksheet grid lends itself to being a chessboard so, when prompted by a question on an online forum, I thought it might be fun to write a little program which produces solutions to the puzzle.

There are several different ways to do this, but I’m going to implement Warnsdorff’s rule. As described at Wikipedia, this rule states that when you are deciding where to move the knight to, you should choose the square which has the least number of subsequent moves and that tie breaks are decided by random choice. This means that the code will tend to move the knight towards the sides or corners of the board, because a knight controls less squares from those places than when it is in the middle. In fact, that’s why chess players generally find that knights are more powerful when they are centrally positioned and that flank pawns can be quite effective against a knight in the end-game.

The first piece of coding is a simple custom class called cChessBoard which will be used to represent the chessboard. When we run the main procedure to solve the puzzle, we’ll add a new worksheet to the workbook and create a chessboard on it, with the top left square of the chessboard being cell C3. Knights move in 2×1 L-shapes so, by picking C3 as the top left cell, we don’t have to worry about possible runtime errors resulting from moving the knight off of the worksheet.

The last point of note is that the cChessBoard class has two internal constants which define the height and width of the board. A chessboard is 8×8 squares, but you can change these values if you want to experiment with different board sizes.

Option Explicit

'a range representing a chessboard's squares
Private prngSquares As Range

Public Sub CreateOn(ByRef wstTarget As Worksheet)

'we will use C3 as the top left square of the board
'so that no knight moves can take us off the worksheet
Const strTOP_LEFT_CELL As String = "C3"

'grid rows and columns representing dimensions of the chess board
'change dimensions to suit (a traditional board is 8x8):
Const lngROW_COUNT As Long = 8
Const lngCOL_COUNT As Long = 8

'create the chessboard
Set prngSquares = wstTarget.Range(strTOP_LEFT_CELL).Resize(lngROW_COUNT, lngCOL_COUNT)

End Sub

Public Property Get Squares() As Range
Set Squares = prngSquares
End Property

Next we need a class called cKnight to represent a knight and which can work out where the knight should move to. This is where we implement the Warnsdorff’s rule mentioned earlier. The methodology is as follows:

• If the knight has not been moved before then place it on a random square.
• Otherwise pick which candidate square to move the knight to:
• Determine all eight candidate squares which the knight can move to, whether or not those candidate squares are valid.
• Determine which of those candidate squares are valid. To be valid, the candidate square must be on the chessboard and must not have been visited by the knight before.
• If there are no valid candidate squares then do not move the knight.
• If there is only one valid candidate square then move the knight to it.
• If there are multiple, valid candidate squares then check them to see how many subsequent, valid moves can be made from each one and pick the one with the least number of subsequent valid moves. Tie breaks are decided by randomly picking a square.
Option Explicit

Private prngCurrentPosition As Range
Private plngMoveCount As Long

'A function to calculate the best, legal move the knight can make
Private Function GetBestMove( _
ByRef rngCurrentSquare As Range, _
ByRef rngChessBoard As Range) As Range

'use Warnsdorff's algorithm to determine the next move:
'we move to the next square which itself has the
'least number of possible legal moves

'the largest number of squares a knight can move to is 8
Const lngMAX_MOVES As Long = 8

Dim rngPrimaryCandidates As Range       'looking one move ahead
Dim rngSecondaryCandidates As Range     'looking two moves ahead
Dim rngPrimaryCandidate As Range        'a cell enumerator
Dim rngBestSquare As Range              'track the best move we find
Dim lngNextMoveCounter As Long          'track the least number of subsequent legal moves

'determine the legal moves the knight can make
Set rngPrimaryCandidates = GetLegalMoves(rngCurrentSquare, rngChessBoard)

'if there are no legal first moves then do nothing
If rngPrimaryCandidates Is Nothing Then
'(set rngBestSquare = nothing)

'if there is only one legal move then we have to move there
ElseIf rngPrimaryCandidates.Areas.Count = 1 Then
Set rngBestSquare = rngPrimaryCandidates

'if there are multiple legal moves we have to determine
'which is the best
Else

lngNextMoveCounter = lngMAX_MOVES

'loop through all the squares which are legal 1st moves
For Each rngPrimaryCandidate In rngPrimaryCandidates.Areas

'determine all the possible legal 2nd moves from the 1st move
Set rngSecondaryCandidates = GetLegalMoves(rngPrimaryCandidate, rngChessBoard)

If Not rngSecondaryCandidates Is Nothing Then
With rngSecondaryCandidates.Areas

'if there are less 2nd moves from that square than
'any others we have checked then we want it
If .Count < lngNextMoveCounter Then
lngNextMoveCounter = .Count
Set rngBestSquare = rngPrimaryCandidate

ElseIf .Count = lngNextMoveCounter Then
'if multiple squares are equally viable we'll randomly pick one
'at the end. This will always be a Union:
Set rngBestSquare = Union(rngBestSquare, rngPrimaryCandidate)
End If
End With
End If
Next rngPrimaryCandidate

'if there are equally good squares to move to then we'll randomly pick one
'as per the traditional Warnsdorff's algorithm
'note that research by Pohl suggests an improvement would be to then count
'the number of possible moves from these squares too and, only if those are also equal,
'to randomly choose one. ("second level tie-breaking")
If Not rngBestSquare Is Nothing Then
If rngBestSquare.Count > 1 Then
Set rngBestSquare = rngBestSquare.Areas(Int((rngBestSquare.Count) * Rnd + 1))
End If
End If
End If

Set GetBestMove = rngBestSquare

End Function

'A function to get all the legal moves the knight can make
Private Function GetLegalMoves( _
ByRef rngCurrentSquare As Range, _
ByRef rngChessBoard As Range) As Range

Dim rngCell As Range

For Each rngCell In GetAllMoves(rngCurrentSquare)
If IsMoveLegal(rngCell, rngChessBoard) Then
If GetLegalMoves Is Nothing Then
Set GetLegalMoves = rngCell
Else
Set GetLegalMoves = Union(GetLegalMoves, rngCell)
End If

End If
Next rngCell
End Function

'A function to determine if a move to a square is allowed
Private Function IsMoveLegal( _
ByRef rngTargetSquare As Range, _
ByRef rngChessBoard As Range) As Boolean

'has the square been visited yet?
If IsEmpty(rngTargetSquare.Value2) Then
'is the square on the chess board?
IsMoveLegal = Not Intersect(rngTargetSquare, rngChessBoard) Is Nothing
End If
End Function

'A function to determine all the possible moves (legal or not) a knight could make
Private Function GetAllMoves(ByRef rngCurrentSquare As Range) As Range
With rngCurrentSquare

'knights move in L shapes
Set GetAllMoves = Union( _
.Offset(-2, -1), .Offset(-2, 1), _
.Offset(-1, -2), .Offset(-1, 2), _
.Offset(1, -2), .Offset(1, 2), _
.Offset(2, -1), .Offset(2, 1) _
)
End With
End Function

'a function to determine a random square on chess board to start from
Private Function GetStartSquare(ByRef rngChessBoard As Range) As Range
With rngChessBoard
Set GetStartSquare = .Cells((.Count * Rnd) + 1)
End With
End Function

Private Sub Class_Initialize()
Randomize
End Sub

'this is the function which will be called to move the knight
Public Function Move(ByRef rngChessBoard As Range) As Boolean

'if the knight hasn't moved before, let's put it on the board
If plngMoveCount = 0 Then
Set prngCurrentPosition = GetStartSquare(rngChessBoard)
prngCurrentPosition.Interior.Color = vbYellow

'otherwise let's find the best move for the knight
Else
Set prngCurrentPosition = GetBestMove(prngCurrentPosition, rngChessBoard)
End If

'if we managed to move the knight then let's put the move
'number on the board and return True to the caller
If Not prngCurrentPosition Is Nothing Then
plngMoveCount = plngMoveCount + 1
prngCurrentPosition.Value2 = plngMoveCount
Move = True
End If

End Function

'a read-only property to return the
'number of moves the knight has made
Public Property Get MoveCount() As Long
MoveCount = plngMoveCount
End Property

Finally we need our main procedure in a standard code module which creates the chessboard and knight, and solves the tour. We’ll give it 10 chances to try to create a valid tour.

Option Explicit

'the main sub to run to try to solve the puzzle
Public Sub Main()

'the maximum number of permissable attempts to solve the puzzle
'change max number of attempts to suit:
Const lngMAX_ATTEMPTS As Long = 10

Dim lngAttempts As Long             'remember how many tries the algorithm has had
Dim strMsg As String                'a report message
Dim clsChessBoard As cChessBoard    'a chessboard object holder
Dim clsKnight As cKnight            'a knight object holder
Dim blnKnightMoved As Boolean

'create a chessboard instance and tell it which sheet it belongs to
Set clsChessBoard = New cChessBoard

'try to solve the puzzle
Do

lngAttempts = lngAttempts + 1

clsChessBoard.Squares.Clear

'create our knight piece which will be moved around the board
Set clsKnight = New cKnight

'move the knight around the board until we run out of available squares
Do
blnKnightMoved = clsKnight.Move(clsChessBoard.Squares)
Loop While blnKnightMoved And (clsKnight.MoveCount < clsChessBoard.Squares.Count)

'did we solve the puzzle?
If clsKnight.MoveCount = clsChessBoard.Squares.Count Then
strMsg = "Solved"
Exit Do
End If
Loop While lngAttempts < lngMAX_ATTEMPTS

'create a report message for the end user
If LenB(strMsg) = 0 Then strMsg = "Failed"
strMsg = strMsg & " after " & CStr(lngAttempts) & " attempt"
If lngAttempts > 1 Then strMsg = strMsg & "s"

MsgBox strMsg
End Sub

Have a go at running the main sub a few times and see how you get on. I found that the algorithm runs pretty quickly and only occasionally requires more than one attempt to solve the puzzle on an 8 x 8 board.