% Filename: KnightHeuristic.lhs % Version : 1.4 % Date : 3/4/92 \section{Knights Tour Heuristic.} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%M O D U L E%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \begin{code} module KnightHeuristic( ChessSet, startTour, descendents, tourFinished ) where \end{code} %%%%%%%%%%%%%%%%%% I M P O R T S / T Y P E D E F S %%%%%%%%%%%%%% This module imports the @ChessSet@ algebraic data type, and a sort function. For reasons unknown to me the crappy @quickSort@ gives the best results when used here??? The enumerated type @Direction@ represents the possible directions in which a knight can move on a chess board. For example the constructor @UL@ represents a knight moving two spaces {\em Up}, then one space {\em Left} on a chess board. \begin{code} import Sort(quickSort) import ChessSetArray data Direction = UL | UR | DL |DR | LU | LD | RU | RD \end{code} %%%%%%%%%%%%%%%%%%%%% B O D Y O F M O D U L E %%%%%%%%%%%%%%%%%%%%% \begin{code} move::Direction -> Tile -> Tile move UL (x,y) = (x-1,y-2) move UR (x,y) = (x+1,y-2) move DL (x,y) = (x-1,y+2) move DR (x,y) = (x+1,y+2) move LU (x,y) = (x-2,y-1) move LD (x,y) = (x-2,y+1) move RU (x,y) = (x+2,y-1) move RD (x,y) = (x+2,y+1) \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% We can short-circuit a knights tour for an odd sized board, because a tour will never exist. This can be proved because if we place a knight anywhere on the board, their will always be a column or row to which the knight cannot move. \begin{code} startTour::Tile -> Int -> ChessSet startTour st size | (size `mod` 2) == 0 = createBoard size st | otherwise = error "Tour doesnt exist for odd size board" \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @MoveKnight@ has a pre-condition that it must be possible to move the knight in direction @dir@. This condition can be checked with a prior call to the @canMove@ function. \begin{code} moveKnight::ChessSet -> Direction -> ChessSet moveKnight board dir = addPiece (move dir (lastPiece board)) board canMove::ChessSet -> Direction -> Bool canMove board dir = canMoveTo (move dir (lastPiece board)) board canMoveTo::Tile -> ChessSet -> Bool canMoveTo t@(x,y) board = (x >= 1) && (x <=sze) && (y >= 1) && (y <=sze) && isSquareFree t board where sze = sizeBoard board \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The function @Descendents@ forms the heart of the knights tour. It has various heuristics built into it that try to reject dead end positions. These set of heuristics are take from Richard's book \cite{bornat:prog1} under the section ``Positively the last flourish''. For reasons not clear to me, the combination of these heuristics work so well that the system finds the first twenty tours\footnote{I could'nt be botherd asking for more} without backtracking ! The Heuristics used in the following function are summerised below : \begin{enumerate} \item At any point in the tour, if it is possible to move to the first tile of the tour, and if by moving to that square produces a dead end, then their is no point in carrying on with the current tour because you will never be able to get back to the first square - dead end. \item At any point in the tour, if for each of the possible moves you can take their is only one position that has a single descendent \footnote{The descendents of a tile is the number of moves you can make from that tile without falling off the board, or jumping onto a tile that has already been visited.}, then you {\em must} take that move otherwise you will be cutting off that tile for a subsequent move in the tour - dead end. \item At any point in the tour, if for each of the possible moves you can take their is more than one position with a single descendent, then you have to abandon the current tour because taking any of the single descendents tiles will cause the other single descendent tiles to be unreachable - dead end. \item At a given point in the tour, if for each of the possible moves you can take, their are no single descendent tiles, then visit the tiles in order of smallest number of descendents first - (don't know why this works, it just does !!!). \end{enumerate} \begin{code} descendents::ChessSet -> [ChessSet] descendents board | (canJumpFirst board) && (deadEnd (addPiece (firstPiece board) board)) = [] | otherwise = case (length singles) of 0 -> map snd (quickSort (descAndNo board)) 1 -> singles _ -> [] -- Going to be dead end where singles = singleDescend board singleDescend::ChessSet -> [ChessSet] singleDescend board =[x | (y,x) <- descAndNo board, y==1] descAndNo::ChessSet -> [(Int,ChessSet)] descAndNo board = [(length (possibleMoves (deleteFirst x)),x) | x<- allDescend board] allDescend::ChessSet -> [ChessSet] allDescend board = map (moveKnight board) (possibleMoves board) possibleMoves::ChessSet -> [Direction] possibleMoves board =[x | x <- [UL,UR,DL,DR,LU,LD,RU,RD], (canMove board x)] deadEnd::ChessSet -> Bool deadEnd board = (length (possibleMoves board)) == 0 canJumpFirst::ChessSet -> Bool canJumpFirst board = canMoveTo (firstPiece board) (deleteFirst board) \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% A tour is finished if their are 64 pieces on the board (in the case of an 8x8 board), and move number 64 of the tour can jump back to the first square (move number 1). \begin{code} tourFinished::ChessSet -> Bool tourFinished board = (noPieces board == sze*sze) && (canJumpFirst board) where sze = sizeBoard board \end{code}