ajb at spamcop.net ajb at spamcop.net
Sun Nov 30 20:54:08 EST 2008

```G'day all.

Quoting Don Stewart <dons at galois.com>:

> So, team, anyone want to implement a Knight's Tour solver in a list
> fast languages with backtracking monads....

I conjecture that any one-liner won't be efficient.

Anyway, here's my ~30 min attempt.  The showBoard and main are both very
quick and dirty, and I'm sure someone can do much better.

I particularly like the fact that changing "Maybe" to "[]" will make
knightsTour return all tours starting at the upper left-hand corner,
rather than just one.  Warm fuzzy things rule.

Cheers,
Andrew Bromage

module Main where

import qualified Data.Set as S
import Data.List
import Data.Function
import Control.Arrow
import System

knightsTour :: Int -> Maybe [(Int,Int)]
knightsTour size
= tour [(0,0)] (S.fromAscList [ (x,y) | x <- [0..size-1], y <-
[0..size-1],
x /= 0 || y /= 0 ])
where
jumps = [(2,1),(1,2),(2,-1),(-1,2),(-2,1),(1,-2),(-2,-1),(-1,-2)]
tour moves@(pos:_) blank
| S.null blank = return (reverse moves)
| otherwise = msum [ tour (npos:moves) (npos `S.delete` blank) |
npos <- nextPositions pos ]
where
nextPositions = map snd . sortBy (compare `on` fst) .
map (length . neighbours &&& id) .
neighbours
neighbours (x,y) = [ npos | (x',y') <- jumps,
let { npos = (x+x',y+y') }, npos `S.member` blank ]

showBoard :: Int -> [(Int,Int)] -> ShowS
showBoard size
= inter bdr .
map (inter ('|':) . map (shows . fst)) .
groupBy ((==) `on` fst.snd) .
sortBy (compare `on` snd) .
zip [1..]
where
bdr = ('\n':) . inter ('+':) (replicate size (replicate width '-' ++))
. ('\n':)
width = length . show \$ size*size
pad s = \r -> replicate (width - length (s "")) ' ' ++ s r
inter sep xs = sep . foldr (.) id [ pad x . sep | x <- xs ]

main :: IO ()
main = do
a <- getArgs
size <- case a of
[] -> return 8