Illustration of a knight tour on an 8x8 chessboard.
import Diagrams.Backend.SVG.CmdLine
A relatively well-known puzzle is to find a sequence of moves by which a knight can visit every square of a chessboard exactly once, without repeating any squares. This example computes such a tour and visualizes the solution.
{-# LANGUAGE NoMonomorphismRestriction #-}
import Data.List (minimumBy, tails, (\\))
import Data.Ord (comparing)
import Diagrams.Prelude
First, we compute a tour by a brute force depth-first search (it does not take very long). This code is adapted from the code found here.
type Square = (Int, Int)
board :: [Square]
= [ (x,y) | x <- [0..7], y <- [0..7] ]
board
knightMoves :: Square -> [Square]
= filter (`elem` board) jumps
knightMoves (x,y) where jumps = [ (x+i,y+j) | i <- jv, j <- jv, abs i /= abs j ]
= [1,-1,2,-2]
jv
knightTour :: Square -> [Square]
= knightTour' [sq]
knightTour sq where
@(lastMove:_)
knightTour' moves| null candMoves = reverse moves
| otherwise = knightTour' $ newSquare : moves
where newSquare = minimumBy (comparing (length . findMoves)) candMoves
= findMoves lastMove
candMoves = knightMoves s \\ moves findMoves s
Now we can go about visualizing a tour. First, let’s draw a chessboard:
boardSq :: Colour Double -> Diagram B
= square 1 # lw none # fc c
boardSq c
chessBoard :: Int -> Diagram B
chessBoard n= vcat . map hcat . map (map boardSq)
. take n . map (take n) . tails
$ cycle [antiquewhite, saddlebrown]
Now, we need a way to convert Square
coordinates (a pair of numbers
in the range 0-7) into actual coordinates on the chessboard. Since
the chessboard ends up with its local origin in the center of the
top-left square, all we need to do is negate the \(y\)-coordinate:
squareToPoint :: Square -> P2 Double
= fromIntegral x ^& negate (fromIntegral y) squareToPoint (x,y)
To draw a knight on a given square, we simply translate the given image appropriately:
knight :: Square -> Diagram B -> Diagram B
= knightImg # moveTo (squareToPoint sq) knight sq knightImg
Given a tour, we turn it into a path using fromVertices
,
and decorate the vertices with dots.
drawTour :: [Square] -> Diagram B
= tourPoints <> strokeP tourPath
drawTour tour where
= fromVertices . map squareToPoint $ tour
tourPath = atPoints (concat . pathVertices $ tourPath) (repeat dot)
tourPoints = circle 0.05 # fc black dot
Finally, we load a knight image, size it to fit a square, and then put all the previous pieces together:
= do
example <- loadImageEmb "doc/static/white-knight.png"
res let knightImg = case res of
Left _ -> mempty
Right img -> image img # sized (mkWidth 1)
return $ mconcat
[ knight tourStart knightImg
, knight tourEnd knightImg
, drawTour tour8
, chessBoard
]where
= (1,3)
tourStart = knightTour tourStart
tour = last tour tourEnd
= mainWith (example :: Diagram B) main